Theory Coincidence

theory "Coincidence" 
imports
  Ordinary_Differential_Equations.ODE_Analysis
  "Ids"
  "Lib"
  "Syntax"
  "Denotational_Semantics"
  "Frechet_Correctness"
  "Static_Semantics"
begin
section ‹Coincidence Theorems and Corollaries›
text ‹This section proves coincidence: semantics of terms, odes, formulas and programs depend only
  on the free variables. This is one of the major lemmas for the correctness of uniform substitutions.
  Along the way, we also prove the equivalence between two similar, but different semantics for ODE programs:
  It does not matter whether the semantics of ODE's insist on the existence of a solution that agrees
  with the start state on all variables vs. one that agrees only on the variables that are actually
  relevant to the ODE. This is proven here by simultaneous induction with the coincidence theorem
  for the following reason:
  
  The reason for having two different semantics is that some proofs are easier with one semantics
  and other proofs are easier with the other definition. The coincidence proof is either with the
  more complicated definition, which should not be used as the main definition because it would make
  the specification for the dL semantics significantly larger, effectively increasing the size of
  the trusted core. However, that the proof of equivalence between the semantics using the coincidence
  lemma for formulas. In order to use the coincidence proof in the equivalence proof and the equivalence
  proof in the coincidence proof, they are proved by simultaneous induction.
  ›

context ids begin
subsection ‹Term Coincidence Theorems›
lemma coincidence_sterm:"Vagree ν ν' (FVT θ) ⟹ sterm_sem I  θ (fst ν) = sterm_sem I θ (fst ν')"
  apply(induct "θ") (* 7 subgoals *)
  apply(auto simp add: Vagree_def)
  by (meson rangeI)

lemma coincidence_sterm':"dfree θ ⟹  Vagree ν ν' (FVT θ) ⟹ Iagree I J {Inl x |x. x ∈ SIGT θ} ⟹ sterm_sem I  θ (fst ν) = sterm_sem J θ (fst ν')"
proof (induction rule: dfree.induct)
  case (dfree_Fun args i)
    then show ?case
    proof (auto)
      assume free:"(⋀i. dfree (args i))"
        and IH:"(⋀i. Vagree ν ν' (FVT (args i)) ⟹ Iagree I J {Inl x |x. x ∈ SIGT (args i)} ⟹ sterm_sem I (args i) (fst ν) = sterm_sem J (args i) (fst ν'))"
        and VA:"Vagree ν ν' (⋃i. FVT (args i))"
        and IA:"Iagree I J {Inl x |x. x = i ∨ (∃xa. x ∈ SIGT (args xa))}"
      from IA have IAorig:"Iagree I J {Inl x |x. x ∈ SIGT (Function i args)}" by auto
      from Iagree_Func[OF IAorig] have eqF:"Functions I i = Functions J i" by auto
      have Vsubs:"⋀i. FVT (args i) ⊆ (⋃i. FVT (args i))" by auto
      from VA 
      have VAs:"⋀i. Vagree ν ν' (FVT (args i))" 
        using agree_sub[OF Vsubs] by auto
      have Isubs:"⋀j. {Inl x |x. x ∈ SIGT (args j)} ⊆ {Inl x |x. x ∈ SIGT (Function i args)}"
        by auto
      from IA
      have IAs:"⋀i. Iagree I J {Inl x |x. x ∈ SIGT (args i)}"
        using Iagree_sub[OF Isubs] by auto
      show "Functions I i (χ i. sterm_sem I (args i) (fst ν)) = Functions J i (χ i. sterm_sem J (args i) (fst ν'))"
        using IH[OF VAs IAs] eqF by auto
    qed  
next
  case (dfree_Plus θ⇩₁ θ⇩₂)
  then show ?case 
  proof (auto)
    assume "dfree θ⇩₁" "dfree θ⇩₂"
      and IH1:"(Vagree ν ν' (FVT θ⇩₁) ⟹ Iagree I J {Inl x |x. x ∈ SIGT θ⇩₁} ⟹ sterm_sem I θ⇩₁ (fst ν) = sterm_sem J θ⇩₁ (fst ν'))"
      and IH2:"(Vagree ν ν' (FVT θ⇩₂) ⟹ Iagree I J {Inl x |x. x ∈ SIGT θ⇩₂} ⟹ sterm_sem I θ⇩₂ (fst ν) = sterm_sem J θ⇩₂ (fst ν'))"
      and VA:"Vagree ν ν' (FVT θ⇩₁ ∪ FVT θ⇩₂)"
      and IA:"Iagree I J {Inl x |x. x ∈ SIGT θ⇩₁ ∨ x ∈ SIGT θ⇩₂}"
    from VA 
    have VAs:"Vagree ν ν' (FVT θ⇩₁)" "Vagree ν ν' (FVT θ⇩₂)"
      unfolding Vagree_def by auto
    have Isubs:"{Inl x |x. x ∈ SIGT θ⇩₁} ⊆ {Inl x |x. x ∈ SIGT (Plus θ⇩₁ θ⇩₂)}"
      "{Inl x |x. x ∈ SIGT θ⇩₂} ⊆ {Inl x |x. x ∈ SIGT (Plus θ⇩₁ θ⇩₂)}"
      by auto
    from IA 
    have IAs:"Iagree I J {Inl x |x. x ∈ SIGT θ⇩₁}" 
      "Iagree I J {Inl x |x. x ∈ SIGT θ⇩₂}"
      using Iagree_sub[OF Isubs(1)] Iagree_sub[OF Isubs(2)] by auto         
    show "sterm_sem I θ⇩₁ (fst ν) + sterm_sem I θ⇩₂ (fst ν) = sterm_sem J θ⇩₁ (fst ν') + sterm_sem J θ⇩₂ (fst ν')"
      using IH1[OF VAs(1) IAs(1)] IH2[OF VAs(2) IAs(2)] by auto
  qed
next
  case (dfree_Times θ⇩₁ θ⇩₂)
  then show ?case 
  proof (auto)
    assume "dfree θ⇩₁" "dfree θ⇩₂"
      and IH1:"(Vagree ν ν' (FVT θ⇩₁) ⟹ Iagree I J {Inl x |x. x ∈ SIGT θ⇩₁} ⟹ sterm_sem I θ⇩₁ (fst ν) = sterm_sem J θ⇩₁ (fst ν'))"
      and IH2:"(Vagree ν ν' (FVT θ⇩₂) ⟹ Iagree I J {Inl x |x. x ∈ SIGT θ⇩₂} ⟹ sterm_sem I θ⇩₂ (fst ν) = sterm_sem J θ⇩₂ (fst ν'))"
      and VA:"Vagree ν ν' (FVT θ⇩₁ ∪ FVT θ⇩₂)"
      and IA:"Iagree I J {Inl x |x. x ∈ SIGT θ⇩₁ ∨ x ∈ SIGT θ⇩₂}"
    from VA 
    have VAs:"Vagree ν ν' (FVT θ⇩₁)" "Vagree ν ν' (FVT θ⇩₂)"
      unfolding Vagree_def by auto
    have Isubs:"{Inl x |x. x ∈ SIGT θ⇩₁} ⊆ {Inl x |x. x ∈ SIGT (Times θ⇩₁ θ⇩₂)}"
      "{Inl x |x. x ∈ SIGT θ⇩₂} ⊆ {Inl x |x. x ∈ SIGT (Times θ⇩₁ θ⇩₂)}"
      by auto
    from IA 
    have IAs:"Iagree I J {Inl x |x. x ∈ SIGT θ⇩₁}" 
      "Iagree I J {Inl x |x. x ∈ SIGT θ⇩₂}"
      using Iagree_sub[OF Isubs(1)] Iagree_sub[OF Isubs(2)] by auto         
    show "sterm_sem I θ⇩₁ (fst ν) * sterm_sem I θ⇩₂ (fst ν) = sterm_sem J θ⇩₁ (fst ν') * sterm_sem J θ⇩₂ (fst ν')"
      using IH1[OF VAs(1) IAs(1)] IH2[OF VAs(2) IAs(2)] by auto
  qed
qed (unfold Vagree_def Iagree_def, auto)

lemma sum_unique_nonzero:
  fixes i::"'sv::finite" and f::"'sv ⇒ real"
  assumes restZero:"⋀j. j∈(UNIV::'sv set) ⟹ j ≠ i ⟹ f j = 0"
  shows "(∑j∈(UNIV::'sv set). f j) = f i"
proof -
  have "(∑j∈(UNIV::'sv set). f j) = (∑j∈{i}. f j)"
    using restZero by (intro sum.mono_neutral_cong_right) auto
  then show ?thesis
    by simp
qed

lemma  coincidence_frechet :
  fixes I :: "('a::finite, 'b::finite, 'c::finite) interp" and ν :: "'c state" and ν'::"'c state"
  shows "dfree θ ⟹ Vagree ν ν' (FVDiff θ) ⟹ frechet I  θ (fst ν) (snd ν) = frechet I  θ (fst ν') (snd ν')"
proof (induction rule: dfree.induct)
  case dfree_Var then show ?case
    by (auto simp: inner_prod_eq Vagree_def)
next
  case dfree_Const then show ?case
    by auto
next
  case (dfree_Fun args var)
  assume free:"(⋀i. dfree (args i))"
  assume IH:"(⋀i. Vagree ν ν' (FVDiff (args i)) ⟹ frechet I (args i) (fst ν) (snd ν) = frechet I (args i) (fst ν') (snd ν'))"
  have frees:"(⋀i. dfree (args i))" using free by (auto simp add: rangeI)
  assume agree:"Vagree ν ν' (FVDiff ($f var args))"
  have agrees:"⋀i. Vagree ν ν' (FVDiff (args i))" using agree agree_func by metis
  have agrees':"⋀i. Vagree ν ν' (FVT (args i))"
    subgoal for i
      using agrees[of i] FVDiff_sub[of "args i"] unfolding Vagree_def by blast
    done
  have sterms:"⋀i. sterm_sem I (args i) (fst ν) = sterm_sem I (args i) (fst ν')" 
    by (rule coincidence_sterm[of "ν"  "ν'", OF agrees'])
  have frechets:"⋀i. frechet I (args i) (fst ν) (snd ν) = frechet I (args i) (fst ν') (snd ν')"  using IH agrees frees rangeI by blast
  show  "?case"
    using agrees sterms frechets by (auto)
next
  case (dfree_Plus t1 t2) 
  assume dfree1:"dfree t1"
  assume IH1:"(Vagree ν ν' (FVDiff t1) ⟹ frechet I t1 (fst ν) (snd ν) = frechet I t1 (fst ν') (snd ν'))"
  assume dfree2:"dfree t2"
  assume IH2:"(Vagree ν ν' (FVDiff t2) ⟹ frechet I t2 (fst ν) (snd ν) = frechet I t2 (fst ν') (snd ν'))"
  assume agree:"Vagree ν ν' (FVDiff (Plus t1 t2))"
  have agree1:"Vagree ν ν' (FVDiff t1)" using agree agree_plus1 by (blast)
  have agree2:"Vagree ν ν' (FVDiff t2)" using agree agree_plus2 by (blast)
  have IH1':"(frechet I t1 (fst ν) (snd ν) = frechet I t1 (fst ν') (snd ν'))"
    using IH1 agree1 by (auto)
  have IH2':"(frechet I t2 (fst ν) (snd ν) = frechet I t2 (fst ν') (snd ν'))"
    using IH2 agree2 by (auto)
  show "?case"
    by (metis FVT.simps(4) IH1' IH2' UnCI Vagree_def coincidence_sterm frechet.simps(3) mem_Collect_eq)
next
  case (dfree_Times t1 t2) 
  assume dfree1:"dfree t1"
  assume IH1:"(Vagree ν ν' (FVDiff t1) ⟹ frechet I t1 (fst ν) (snd ν) = frechet I t1 (fst ν') (snd ν'))"
  assume dfree2:"dfree t2"
  assume IH2:"(Vagree ν ν' (FVDiff t2) ⟹ frechet I t2 (fst ν) (snd ν) = frechet I t2 (fst ν') (snd ν'))"
  assume agree:"Vagree ν ν' (FVDiff (Times t1 t2))"
  have agree1:"Vagree ν ν' (FVDiff t1)" using agree agree_times1 by blast
  have agree2:"Vagree ν ν' (FVDiff t2)" using agree agree_times2 by blast
  have agree1':"Vagree ν ν' (FVT t1)"
    using agree1 apply(auto simp add: Vagree_def)
     using primify_contains by blast+
  have agree2':"Vagree ν ν' (FVT t2)"
    using agree2 apply(auto simp add: Vagree_def)
     using primify_contains by blast+
  have IH1':"(frechet I t1 (fst ν) (snd ν) = frechet I t1 (fst ν') (snd ν'))"
    using IH1 agree1 by (auto)
  have IH2':"(frechet I t2 (fst ν) (snd ν) = frechet I t2 (fst ν') (snd ν'))"
    using IH2 agree2 by (auto)
  have almost:"Vagree ν ν' (FVT (Times t1 t2)) ⟹ frechet I (Times t1 t2) (fst ν) (snd ν) = frechet I (Times t1 t2) (fst ν') (snd ν')"
    by (auto simp add: UnCI Vagree_def agree IH1' IH2' coincidence_sterm[OF agree1', of I] coincidence_sterm[OF agree2', of I])
  show "?case"
    using agree FVDiff_sub almost
    by (metis agree_supset)
qed

lemma  coincidence_frechet' :
  fixes I J :: "('a::finite, 'b::finite, 'c::finite) interp" and ν :: "'c state" and ν'::"'c state"
  shows "dfree θ ⟹ Vagree ν ν' (FVDiff θ) ⟹ Iagree I J {Inl x | x. x ∈ (SIGT θ)} ⟹ frechet I  θ (fst ν) (snd ν) = frechet J  θ (fst ν') (snd ν')"
proof (induction rule: dfree.induct)
  case dfree_Var then show ?case
    by (auto simp: inner_prod_eq Vagree_def)
next
  case dfree_Const then show ?case
    by auto
next
  case (dfree_Fun args var)
  assume free:"(⋀i. dfree (args i))"
  assume IH:"(⋀i. Vagree ν ν' (FVDiff (args i)) ⟹ Iagree I J {Inl x |x. x ∈ SIGT (args i)} ⟹ frechet I (args i) (fst ν) (snd ν) = frechet J (args i) (fst ν') (snd ν'))"
  have frees:"(⋀i. dfree (args i))" using free by (auto simp add: rangeI)
  assume agree:"Vagree ν ν' (FVDiff ($f var args))"
  assume IA:"Iagree I J {Inl x |x. x ∈ SIGT ($f var args)}"
  have agrees:"⋀i. Vagree ν ν' (FVDiff (args i))" using agree agree_func by metis
  then have agrees':"⋀i. Vagree ν ν' (FVT (args i))"
    using agrees  FVDiff_sub 
    by (metis agree_sub)
  from Iagree_Func [OF IA ]have fEq:"Functions I var = Functions J var" by auto 
  have subs:"⋀i.{Inl x |x. x ∈ SIGT (args i)} ⊆ {Inl x |x. x ∈ SIGT ($f var args)}"
    by auto
  from IA have IAs:"⋀i. Iagree I J {Inl x |x. x ∈ SIGT (args i)}"
    using Iagree_sub[OF subs] by auto
  have sterms:"⋀i. sterm_sem I (args i) (fst ν) = sterm_sem J (args i) (fst ν')"
    subgoal for i
      using frees agrees' coincidence_sterm'[of "args i" ν ν' I J] IAs 
      by (auto)  
    done
  have frechets:"⋀i. frechet I (args i) (fst ν) (snd ν) = frechet J (args i) (fst ν') (snd ν')"  
    using IH[OF agrees IAs] agrees frees rangeI by blast
  show "?case"
    using agrees agrees' sterms frechets fEq by auto
next
  case (dfree_Plus t1 t2) 
  assume dfree1:"dfree t1"
  assume dfree2:"dfree t2"
  assume IH1:"(Vagree ν ν' (FVDiff t1) ⟹ Iagree I J {Inl x |x. x ∈ SIGT t1} ⟹ frechet I t1 (fst ν) (snd ν) = frechet J t1 (fst ν') (snd ν'))"
  assume IH2:"(Vagree ν ν' (FVDiff t2) ⟹ Iagree I J {Inl x |x. x ∈ SIGT t2} ⟹  frechet I t2 (fst ν) (snd ν) = frechet J t2 (fst ν') (snd ν'))"
  assume agree:"Vagree ν ν' (FVDiff (Plus t1 t2))"
  assume IA:"Iagree I J {Inl x |x. x ∈ SIGT (Plus t1 t2)}"
  have subs:"{Inl x |x. x ∈ SIGT t1} ⊆ {Inl x |x. x ∈ SIGT (Plus t1 t2)}" "{Inl x |x. x ∈ SIGT t2} ⊆ {Inl x |x. x ∈ SIGT (Plus t1 t2)}"
    by auto
  from IA 
    have IA1:"Iagree I J {Inl x |x. x ∈ SIGT t1}"
    and  IA2:"Iagree I J {Inl x |x. x ∈ SIGT t2}"
    using Iagree_sub[OF subs(1)] Iagree_sub[OF subs(2)] by auto
  have agree1:"Vagree ν ν' (FVDiff t1)" using agree agree_plus1 by (blast)
  have agree2:"Vagree ν ν' (FVDiff t2)" using agree agree_plus2 by (blast)
  have agree1':"Vagree ν ν' (FVT t1)" using agree1 primify_contains by (auto simp add: Vagree_def, metis)
  have agree2':"Vagree ν ν' (FVT t2)" using agree2 primify_contains by (auto simp add: Vagree_def, metis)
  have IH1':"(frechet I t1 (fst ν) (snd ν) = frechet J t1 (fst ν') (snd ν'))"
    using IH1 agree1 IA1 by (auto)
  have IH2':"(frechet I t2 (fst ν) (snd ν) = frechet J t2 (fst ν') (snd ν'))"
    using IH2 agree2 IA2 by (auto)
  show "?case"
    using coincidence_sterm[OF agree1'] coincidence_sterm[OF agree1'] coincidence_sterm[OF agree2']
    by (auto simp add: IH1' IH2' UnCI Vagree_def)

next
  case (dfree_Times t1 t2) 
  assume dfree1:"dfree t1"
  assume dfree2:"dfree t2"
  assume IH1:"(Vagree ν ν' (FVDiff t1) ⟹ Iagree I J {Inl x |x. x ∈ SIGT t1} ⟹ frechet I t1 (fst ν) (snd ν) = frechet J t1 (fst ν') (snd ν'))"
  assume IH2:"(Vagree ν ν' (FVDiff t2) ⟹ Iagree I J {Inl x |x. x ∈ SIGT t2} ⟹  frechet I t2 (fst ν) (snd ν) = frechet J t2 (fst ν') (snd ν'))"
  assume agree:"Vagree ν ν' (FVDiff (Times t1 t2))"
  assume IA:"Iagree I J {Inl x |x. x ∈ SIGT (Times t1 t2)}"
  have subs:"{Inl x |x. x ∈ SIGT t1} ⊆ {Inl x |x. x ∈ SIGT (Times t1 t2)}" "{Inl x |x. x ∈ SIGT t2} ⊆ {Inl x |x. x ∈ SIGT (Times t1 t2)}"
    by auto
  from IA 
    have IA1:"Iagree I J {Inl x |x. x ∈ SIGT t1}"
    and  IA2:"Iagree I J {Inl x |x. x ∈ SIGT t2}"
    using Iagree_sub[OF subs(1)] Iagree_sub[OF subs(2)] by auto
  have agree1:"Vagree ν ν' (FVDiff t1)" using agree agree_times1 by (blast) 
  then have agree1':"Vagree ν ν' (FVT t1)"
    using agree1 primify_contains by (auto simp add: Vagree_def, metis)
  have agree2:"Vagree ν ν' (FVDiff t2)" using agree agree_times2 by (blast)
  then have agree2':"Vagree ν ν' (FVT t2)"
    using agree2 primify_contains by (auto simp add: Vagree_def, metis)
  have IH1':"(frechet I t1 (fst ν) (snd ν) = frechet J t1 (fst ν') (snd ν'))"
    using IH1 agree1 IA1 by (auto)
  have IH2':"(frechet I t2 (fst ν) (snd ν) = frechet J t2 (fst ν') (snd ν'))"
    using IH2 agree2 IA2 by (auto)
  note co1 = coincidence_sterm'[of "t1" ν ν' I J] and co2 = coincidence_sterm'[of "t2" ν ν' I J]
  show "?case"
    using co1 [OF dfree1 agree1' IA1] co2 [OF dfree2 agree2' IA2] IH1' IH2' by auto
qed

lemma coincidence_dterm:
  fixes I :: "('a::finite, 'b::finite, 'c::finite) interp" and ν :: "'c state" and ν'::"'c state"
  shows "dsafe θ ⟹ Vagree ν ν' (FVT θ) ⟹ dterm_sem I θ ν = dterm_sem I θ ν'"
proof (induction rule: dsafe.induct)
  case (dsafe_Fun args f)
  assume safe:"(⋀i. dsafe (args i))"
  assume IH:"⋀i. Vagree ν ν' (FVT (args i)) ⟹ dterm_sem I (args i) ν = dterm_sem I (args i) ν'"
  assume agree:"Vagree ν ν' (FVT ($f f args))"
  then have "⋀i. Vagree ν ν' (FVT (args i))"
    using agree_func_fvt by (metis)
  then show "?case"
    using safe coincidence_sterm IH rangeI by (auto)
qed (auto simp: Vagree_def directional_derivative_def coincidence_frechet)

lemma coincidence_dterm':
  fixes I J :: "('a::finite, 'b::finite, 'c::finite) interp" and ν :: "'c::finite state" and ν'::"'c::finite state"
  shows "dsafe θ ⟹ Vagree ν ν' (FVT θ) ⟹ Iagree I J {Inl x | x. x ∈ (SIGT θ)} ⟹ dterm_sem I θ ν = dterm_sem J θ ν'"
proof (induction rule: dsafe.induct)
  case (dsafe_Fun args f) then 
    have safe:"(⋀i. dsafe (args i))"
    and IH:"⋀i. Vagree ν ν' (FVT (args i)) ⟹ Iagree I J {Inl x | x. x ∈ (SIGT (args i))} ⟹  dterm_sem I (args i) ν = dterm_sem J (args i) ν'"
    and agree:"Vagree ν ν' (FVT ($f f args))"
    and IA:"Iagree I J {Inl x |x. x ∈ SIGT ($f f args)}"
      by auto
    have subs:"⋀i. {Inl x |x. x ∈ SIGT (args i)} ⊆ {Inl x |x. x ∈ SIGT ($f f args)}" by auto
    from IA have IAs:
      "⋀i. Iagree I J {Inl x |x. x ∈ SIGT (args i)}"
        using Iagree_sub [OF subs IA] by auto
    from agree have agrees:"⋀i. Vagree ν ν' (FVT (args i))"
      using agree_func_fvt by (metis)
    from Iagree_Func [OF IA] have fEq:"Functions I f = Functions J f" by auto 
    then show "?case"
      using safe coincidence_sterm IH[OF agrees IAs] rangeI agrees fEq
      by (auto)
next
  case (dsafe_Plus θ⇩₁ θ⇩₂) then
  have safe:"dsafe θ⇩₁" "dsafe θ⇩₂"
  and IH1:"Vagree ν ν' (FVT θ⇩₁) ⟹ Iagree I J {Inl x |x. x ∈ SIGT θ⇩₁} ⟹ dterm_sem I θ⇩₁ ν = dterm_sem J θ⇩₁ ν'"
  and IH2:"Vagree ν ν' (FVT θ⇩₂) ⟹ Iagree I J {Inl x |x. x ∈ SIGT θ⇩₂} ⟹ dterm_sem I θ⇩₂ ν = dterm_sem J θ⇩₂ ν'"
  and VA:"Vagree ν ν' (FVT (Plus θ⇩₁ θ⇩₂))"
  and IA:"Iagree I J {Inl x |x. x ∈ SIGT (Plus θ⇩₁ θ⇩₂)}"
    by auto
  from VA have VA1:"Vagree ν ν' (FVT θ⇩₁)" and VA2:"Vagree ν ν' (FVT θ⇩₂)" 
    unfolding Vagree_def by auto
  have subs:"{Inl x |x. x ∈ SIGT θ⇩₁} ⊆ {Inl x |x. x ∈ SIGT (Plus θ⇩₁ θ⇩₂)}" 
    "{Inl x |x. x ∈ SIGT θ⇩₂} ⊆ {Inl x |x. x ∈ SIGT (Plus θ⇩₁ θ⇩₂)}"by auto
  from IA have IA1:"Iagree I J {Inl x |x. x ∈ SIGT θ⇩₁}" and IA2:"Iagree I J {Inl x |x. x ∈ SIGT θ⇩₂}"
    using Iagree_sub subs by auto
  then show ?case 
    using IH1[OF VA1 IA1] IH2[OF VA2 IA2] by auto
next
  case (dsafe_Times θ⇩₁ θ⇩₂) then
  have safe:"dsafe θ⇩₁" "dsafe θ⇩₂"
    and IH1:"Vagree ν ν' (FVT θ⇩₁) ⟹ Iagree I J {Inl x |x. x ∈ SIGT θ⇩₁} ⟹ dterm_sem I θ⇩₁ ν = dterm_sem J θ⇩₁ ν'"
    and IH2:"Vagree ν ν' (FVT θ⇩₂) ⟹ Iagree I J {Inl x |x. x ∈ SIGT θ⇩₂} ⟹ dterm_sem I θ⇩₂ ν = dterm_sem J θ⇩₂ ν'"
    and VA:"Vagree ν ν' (FVT (Times θ⇩₁ θ⇩₂))"
    and IA:"Iagree I J {Inl x |x. x ∈ SIGT (Times θ⇩₁ θ⇩₂)}"
    by auto
  from VA have VA1:"Vagree ν ν' (FVT θ⇩₁)" and VA2:"Vagree ν ν' (FVT θ⇩₂)" 
    unfolding Vagree_def by auto
  have subs:"{Inl x |x. x ∈ SIGT θ⇩₁} ⊆ {Inl x |x. x ∈ SIGT (Times θ⇩₁ θ⇩₂)}" 
    "{Inl x |x. x ∈ SIGT θ⇩₂} ⊆ {Inl x |x. x ∈ SIGT (Times θ⇩₁ θ⇩₂)}"by auto
  from IA have IA1:"Iagree I J {Inl x |x. x ∈ SIGT θ⇩₁}" and IA2:"Iagree I J {Inl x |x. x ∈ SIGT θ⇩₂}"
    using Iagree_sub subs by auto
  then show ?case 
    using IH1[OF VA1 IA1] IH2[OF VA2 IA2] by auto  
qed (auto simp: Vagree_def directional_derivative_def coincidence_frechet')

subsection ‹ODE Coincidence Theorems›
lemma coincidence_ode:
  fixes I J :: "('a::finite, 'b::finite, 'c::finite) interp" and ν :: "'c::finite state" and ν'::"'c::finite state"
  shows "osafe ODE ⟹ 
         Vagree ν ν' (Inl ` FVO ODE) ⟹ 
         Iagree I J ({Inl x | x. Inl x ∈ SIGO ODE}  ∪  {Inr (Inr x) | x. Inr x ∈ SIGO ODE}) ⟹ 
         ODE_sem I ODE (fst ν) = ODE_sem J ODE (fst ν')"
proof (induction rule: osafe.induct)
  case (osafe_Var c)
  then show ?case
  proof (auto)
    assume VA:"Vagree ν ν' (range Inl)"
    have eqV:"(fst ν) = (fst ν')"
      using agree_UNIV_fst[OF VA] by auto
    assume IA:"Iagree I J {Inr (Inr c)}"
    have eqIJ:"ODEs I c = ODEs J c"
      using Iagree_ODE[OF IA] by auto
    show "ODEs I c (fst ν) = ODEs J c (fst ν')"
      by (auto simp add: eqV eqIJ)
  qed
next
  case (osafe_Sing θ x)
  then show ?case
  proof (auto)
  assume free:"dfree θ"
  and VA:"Vagree ν ν' (insert (Inl x) (Inl ` {x. Inl x ∈ FVT θ}))"
  and IA:"Iagree I J {Inl x |x. x ∈ SIGT θ}"
  from VA have VA':"Vagree ν ν' {Inl x | x. Inl x ∈ FVT θ}" unfolding Vagree_def by auto
  have agree_Lem:"⋀θ. dfree θ ⟹ Vagree ν ν' {Inl x | x. Inl x ∈ FVT θ} ⟹ Vagree ν ν' (FVT θ)"
    subgoal for θ
      apply(induction rule: dfree.induct)
      by(auto simp add: Vagree_def)
    done
  have trm:"sterm_sem I  θ (fst ν) = sterm_sem J θ (fst ν')"
    using coincidence_sterm' free VA' IA agree_Lem[of θ, OF free] by blast
  show "(λi. if i = x then sterm_sem I θ (fst ν) else 0) =
        (λi. if i = x then sterm_sem J θ (fst ν') else 0)"
    by (auto simp add: vec_eq_iff trm)
  qed
next
  case (osafe_Prod ODE1 ODE2)
  then show ?case 
  proof (auto)
    assume safe1:"osafe ODE1"
      and  safe2:"osafe ODE2"
      and  disjoint:"ODE_dom ODE1 ∩ ODE_dom ODE2 = {}"
      and  IH1:"Vagree ν ν' (Inl ` FVO ODE1) ⟹
         Iagree I J ({Inl x |x. Inl x ∈ SIGO ODE1} ∪ {Inr (Inr x) |x. Inr x ∈ SIGO ODE1}) ⟹ ODE_sem I ODE1 (fst ν) = ODE_sem J ODE1 (fst ν')"
      and  IH2:"Vagree ν ν' (Inl ` FVO ODE2) ⟹
      Iagree I J ({Inl x |x. Inl x ∈ SIGO ODE2} ∪ {Inr (Inr x) |x. Inr x ∈ SIGO ODE2}) ⟹ ODE_sem I ODE2 (fst ν) = ODE_sem J ODE2 (fst ν')"
      and VA:"Vagree ν ν' (Inl ` (FVO ODE1 ∪  FVO ODE2))"
      and IA:"Iagree I J ({Inl x |x. Inl x ∈ SIGO ODE1 ∨ Inl x ∈ SIGO ODE2} ∪ {Inr (Inr x) |x. Inr x ∈ SIGO ODE1 ∨ Inr x ∈ SIGO ODE2})"
    let ?IA = "({Inl x |x. Inl x ∈ SIGO ODE1 ∨ Inl x ∈ SIGO ODE2} ∪ {Inr (Inr x) |x. Inr x ∈ SIGO ODE1 ∨ Inr x ∈ SIGO ODE2})"
    have FVsubs:
      "Inl ` FVO ODE2 ⊆ Inl ` (FVO ODE1 ∪ FVO ODE2)"
      "Inl ` FVO ODE1 ⊆ Inl ` (FVO ODE1 ∪ FVO ODE2)"
      by auto
    from VA 
    have VA1:"Vagree ν ν' (Inl ` FVO ODE1)"
     and VA2:"Vagree ν ν' (Inl ` FVO ODE2)"
      using agree_sub[OF FVsubs(1)] agree_sub[OF FVsubs(2)] 
      by (auto)
    have SIGsubs:
      "({Inl x |x. Inl x ∈ SIGO ODE1} ∪ {Inr (Inr x) |x. Inr x ∈ SIGO ODE1}) ⊆ ?IA"
      "({Inl x |x. Inl x ∈ SIGO ODE2} ∪ {Inr (Inr x) |x. Inr x ∈ SIGO ODE2}) ⊆ ?IA"
      by auto
    from IA
    have IA1:"Iagree I J ({Inl x |x. Inl x ∈ SIGO ODE1} ∪ {Inr (Inr x) |x. Inr x ∈ SIGO ODE1})"
      and IA2:"Iagree I J ({Inl x |x. Inl x ∈ SIGO ODE2} ∪ {Inr (Inr x) |x. Inr x ∈ SIGO ODE2})"
      using Iagree_sub[OF SIGsubs(1)] Iagree_sub[OF SIGsubs(2)] by auto
    show "ODE_sem I ODE1 (fst ν) + ODE_sem I ODE2 (fst ν) = ODE_sem J ODE1 (fst ν') + ODE_sem J ODE2 (fst ν')"
      using IH1[OF VA1 IA1] IH2[OF VA2 IA2] by auto
  qed
qed
  
lemma coincidence_ode':
  fixes I J :: "('a::finite, 'b::finite, 'c::finite) interp" and ν :: "'c simple_state" and ν'::"'c simple_state"
  shows "osafe ODE ⟹ 
         VSagree ν ν'  (FVO ODE) ⟹ 
         Iagree I J ({Inl x | x. Inl x ∈ SIGO ODE}  ∪  {Inr (Inr x) | x. Inr x ∈ SIGO ODE}) ⟹ 
         ODE_sem I ODE ν = ODE_sem J ODE ν'"
  using coincidence_ode[of ODE  "(ν, χ i. 0)" "(ν', χ i. 0)" I J]
  apply(auto)
  unfolding VSagree_def Vagree_def apply auto
  done
  
lemma alt_sem_lemma:"⋀ I::('a::finite,'b::finite,'c::finite) interp. ⋀  ODE::('a::finite,'c::finite) ODE. ⋀sol. ⋀t::real. ⋀ ab. osafe ODE ⟹ 
  ODE_sem I ODE (sol t) = ODE_sem I ODE (χ i. if i ∈ FVO ODE then sol t $ i else ab $ i)"
proof -
  fix I::"('a,'b,'c) interp" 
    and ODE::"('a,'c) ODE"
    and sol 
    and t::real
    and ab
  assume safe:"osafe ODE"
  have VA:"VSagree (sol t) (χ i. if i ∈ FVO ODE then sol t $ i else ab $ i) (FVO ODE)"
    unfolding VSagree_def Vagree_def by auto
  have IA: "Iagree I I ({Inl x | x. Inl x ∈ SIGO ODE}  ∪  {Inr (Inr x) | x. Inr x ∈ SIGO ODE})" unfolding Iagree_def by auto
  show "ODE_sem I ODE (sol t) = ODE_sem I ODE (χ i. if  i ∈ FVO ODE then sol t $ i else ab $ i)" 
    using coincidence_ode'[OF safe VA IA] by auto
qed  
  
lemma bvo_to_fvo:"Inl x ∈ BVO ODE ⟹  x ∈ FVO ODE"
proof (induction ODE)
qed auto
  
lemma ode_to_fvo:"x ∈ ODE_vars I ODE ⟹  x ∈ FVO ODE"
proof (induction ODE)
qed auto

definition coincide_hp :: "('a::finite, 'b::finite, 'c::finite) hp ⇒ ('a::finite, 'b::finite, 'c::finite) interp ⇒ ('a::finite, 'b::finite, 'c::finite) interp ⇒ bool"
where "coincide_hp α I J ⟷ (∀ ν ν' μ V. Iagree I J (SIGP α) ⟶ Vagree ν ν' V ⟶ V ⊇ (FVP α) ⟶ (ν, μ) ∈ prog_sem I α ⟶ (∃μ'. (ν', μ') ∈ prog_sem J α ∧ Vagree μ μ' (MBV α ∪ V)))"

definition ode_sem_equiv ::"('a::finite, 'b::finite, 'c::finite) hp ⇒ ('a::finite, 'b::finite, 'c::finite) interp ⇒ bool"
where "ode_sem_equiv α I ⟷
   (∀ODE::('a::finite,'c::finite) ODE. ∀φ::('a::finite,'b::finite,'c::finite)formula. osafe ODE ⟶ fsafe φ  ⟶
   (α = EvolveODE ODE φ) ⟶
  {(ν, mk_v I ODE ν (sol t)) | ν sol t.
      t ≥ 0 ∧
      (sol solves_ode (λ_. ODE_sem I ODE)) {0..t} {x. mk_v I ODE ν x ∈ fml_sem I φ} ∧
      VSagree (sol 0) (fst ν) {x | x. Inl x ∈ FVP (EvolveODE ODE φ)}} = 
  {(ν, mk_v I ODE ν (sol t)) | ν sol t.
      t ≥ 0 ∧
      (sol solves_ode (λ_. ODE_sem I ODE)) {0..t} {x. mk_v I ODE ν x ∈ fml_sem I φ} ∧
      sol 0 = fst ν})"
  
definition coincide_hp' :: "('a::finite, 'b::finite, 'c::finite) hp ⇒ bool"
where "coincide_hp' α ⟷ (∀ I J. coincide_hp α I J ∧ ode_sem_equiv α I)"

definition coincide_fml  :: "('a::finite, 'b::finite, 'c::finite) formula ⇒ bool"
where "coincide_fml φ ⟷ (∀ ν ν' I J . Iagree I J (SIGF φ) ⟶ Vagree ν ν' (FVF φ) ⟶ ν ∈ fml_sem I φ ⟷ ν' ∈ fml_sem J φ)"

lemma coinc_fml [simp]: "coincide_fml φ  = (∀ ν ν' I J. Iagree I J (SIGF φ) ⟶ Vagree ν ν' (FVF φ) ⟶ ν ∈ fml_sem I φ ⟷ ν' ∈ fml_sem J φ)"
  unfolding coincide_fml_def by auto

subsection ‹Coincidence Theorems for Programs and Formulas›
lemma coincidence_hp_fml:
  fixes α::"('a::finite, 'b::finite, 'c::finite) hp"
  fixes φ::"('a::finite, 'b::finite, 'c::finite) formula"
 shows "(hpsafe α ⟶ coincide_hp' α) ∧ (fsafe φ ⟶ coincide_fml φ)"
proof (induction rule: hpsafe_fsafe.induct)
  case (hpsafe_Pvar x)
  thus "?case" 
    apply(unfold coincide_hp'_def | rule allI | rule conjI)+
     prefer 2 unfolding ode_sem_equiv_def subgoal by auto
    unfolding coincide_hp_def apply(auto)
    subgoal for I J a b aa ba ab bb V
    proof -
      assume IA:"Iagree I J {Inr (Inr x)}"
        have Peq:"⋀y. y ∈ Programs I x ⟷ y ∈ Programs J x" using Iagree_Prog[OF IA] by auto
      assume agree:"Vagree (a, b) (aa, ba) V"
        and sub:"UNIV ⊆ V"
        and sem:"((a, b), ab, bb) ∈ Programs I x"
      from agree_UNIV_eq[OF agree_sub [OF sub agree]]
      have eq:"(a,b) = (aa,ba)" by auto
      hence sem':"((aa,ba), (ab,bb)) ∈ Programs I x"
        using sem by auto
      have triv_sub:"V ⊆ UNIV" by auto
      have VA:"Vagree (ab,bb) (ab,bb) V" using agree_sub[OF triv_sub agree_refl[of "(ab,bb)"]] eq
        by auto
      show "∃a b. ((aa, ba), a, b) ∈ Programs J x ∧ Vagree (ab, bb) (a, b) V"
        apply(rule exI[where x="ab"])
        apply(rule exI[where x="bb"])
        using sem eq VA by (auto simp add: Peq)
    qed
    done
next
  case (hpsafe_Assign e x) then 
  show "?case" 
  proof (auto simp only: coincide_hp'_def ode_sem_equiv_def coincide_hp_def)
    fix I J :: "('a::finite,'b::finite,'c::finite) interp" 
      and ν1 ν2 ν'1 ν'2 μ1 μ2 V
    assume safe:"dsafe e"
      and IA:"Iagree I J (SIGP (x := e))"
      and VA:"Vagree (ν1, ν2) (ν'1, ν'2) V"
      and sub:"FVP (x := e) ⊆ V"
      and sem:"((ν1, ν2), (μ1, μ2)) ∈ prog_sem I (x := e)"
    from VA have VA':"Vagree (ν1, ν2) (ν'1, ν'2) (FVT e)" unfolding FVP.simps Vagree_def using sub by auto
    have Ssub:"{Inl x | x. x ∈ SIGT e} ⊆ (SIGP (x := e))" by auto
    from IA have IA':"Iagree I J {Inl x | x. x ∈ SIGT e}" using Ssub unfolding SIGP.simps by auto
    have "((ν1, ν2), repv (ν1, ν2) x (dterm_sem I e (ν1, ν2))) ∈ prog_sem I (x := e)" by auto
    then have sem':"((ν'1, ν'2), repv (ν'1, ν'2) x (dterm_sem J e (ν'1, ν'2))) ∈ prog_sem J (x := e)" 
      using coincidence_dterm' safe VA' IA' by auto
    from sem have eq:"(μ1, μ2) = (repv (ν1, ν2) x (dterm_sem I e (ν1, ν2)))" by auto
    have VA'':"Vagree (μ1, μ2) (repv (ν'1, ν'2) x (dterm_sem J e (ν'1, ν'2))) (MBV (x := e) ∪ V)" 
      using coincidence_dterm'[of e "(ν1,ν2)" "(ν'1,ν'2)" I J] safe VA' IA' eq agree_refl VA unfolding MBV.simps Vagree_def
      by auto
    show "∃μ'. ((ν'1, ν'2), μ') ∈ prog_sem J (x := e) ∧ Vagree (μ1, μ2) μ' (MBV (x := e) ∪ V)"
      using VA'' sem' by blast
  qed
next
  case (hpsafe_DiffAssign e x) then show "?case" 
  proof (auto simp only: coincide_hp'_def ode_sem_equiv_def coincide_hp_def)
    fix I J::"('a,'b,'c) interp"
      and ν ν' μ V 
    assume safe:"dsafe e"
      and IA:"Iagree I J (SIGP (DiffAssign x e))"
      and VA:"Vagree ν ν' V"
      and sub:"FVP (DiffAssign x e) ⊆ V"
      and sem:"(ν, μ) ∈ prog_sem I (DiffAssign x e)"
    from VA have VA':"Vagree ν ν' (FVT e)" unfolding FVP.simps Vagree_def using sub by auto
    have Ssub:"{Inl x | x. x ∈ SIGT e} ⊆ (SIGP (DiffAssign x e))" by auto
    from IA have IA':"Iagree I J {Inl x | x. x ∈ SIGT e}" using Ssub unfolding SIGP.simps by auto
    have "(ν, repv ν x (dterm_sem I e ν)) ∈ prog_sem I (x := e)" by auto
    then have sem':"(ν', repd ν' x (dterm_sem J e ν')) ∈ prog_sem J (DiffAssign x e)" 
      using coincidence_dterm' safe VA' IA' by auto
    from sem have eq:"μ = (repd ν x (dterm_sem I e ν))" by auto
    have VA':"Vagree μ (repd ν' x (dterm_sem J e ν')) (MBV (DiffAssign x e) ∪ V)" 
      using coincidence_dterm'[OF safe VA', of I J, OF IA'] eq agree_refl VA unfolding MBV.simps Vagree_def
      by auto
    show "∃μ'. (ν', μ') ∈ prog_sem J (DiffAssign x e) ∧ Vagree μ μ' (MBV (DiffAssign x e) ∪ V)"
      using VA' sem' by blast
  qed

next
  case (hpsafe_Test P) then 
  show "?case" 
  proof (auto simp add:coincide_hp'_def ode_sem_equiv_def coincide_hp_def)
    fix I J::"('a,'b,'c) interp" and ν ν' ω ω' ::"'c simple_state"
      and V
    assume safe:"fsafe P"
    assume "∀a b aa ba I J. (Iagree I J (SIGF P) ⟶ Vagree (a, b) (aa, ba) (FVF P) ⟶ ((a, b) ∈ fml_sem I P) = ((aa, ba) ∈ fml_sem J P))"
    hence IH:"Iagree I J (SIGF P) ⟹ Vagree (ν, ν') (ω, ω') (FVF P) ⟹ ((ν, ν') ∈ fml_sem I P) = ((ω, ω') ∈ fml_sem J P)"
      by auto
    assume IA:"Iagree I J (SIGF P)"
    assume VA:"Vagree (ν, ν') (ω, ω') V"
    assume sub:"FVF P ⊆ V"
      hence VA':"Vagree (ν, ν') (ω, ω') (FVF P)" using agree_supset VA by auto
    assume sem:"(ν, ν') ∈ fml_sem I P"
    show "(ω, ω') ∈ fml_sem J P" using IH[OF IA VA'] sem by auto
    qed
next
  case (hpsafe_Evolve ODE P) then show "?case"
    proof (unfold coincide_hp'_def)
      assume osafe:"osafe ODE"
      assume fsafe:"fsafe P"
      assume IH:"coincide_fml P"
      from IH have IHF:"⋀ν ν' I J. Iagree I J (SIGF P) ⟹ Vagree ν ν' (FVF P) ⟹ (ν ∈ fml_sem I P) = (ν' ∈ fml_sem J P)"
        unfolding coincide_fml_def by auto
      have equiv:"⋀I. ode_sem_equiv (EvolveODE ODE P) I"
        subgoal for I
          apply(unfold ode_sem_equiv_def)
          apply(rule allI)+
          subgoal for ODE φ
            apply(rule impI)+
            apply(auto) (* 2 subgoals *)
            subgoal for aa ba ab bb sol t
              apply(rule exI[where x="(λt. χ i. if i ∈ FVO ODE then sol t $ i else ab $ i)"])
              apply(rule conjI)
              subgoal using mk_v_agree[of I ODE "(ab,bb)" "sol t"] mk_v_agree[of I ODE "(ab,bb)" "(χ i. if  i ∈ FVO ODE then sol t $ i else ab $ i)"]
                unfolding Vagree_def VSagree_def by (auto simp add: vec_eq_iff)
              apply(rule exI[where x=t])
              apply(rule conjI) (* 2 subgoals*)
              subgoal
                apply(rule agree_UNIV_eq)
                using mk_v_agree[of I ODE "(ab,bb)" "sol t"] 
                mk_v_agree[of I ODE "(ab,bb)" "(χ i. if  i ∈ FVO ODE then sol t $ i else ab $ i)"]
                mk_v_agree[of I ODE "(χ i. if  i ∈ FVO ODE then sol 0 $ i else ab $ i, bb)" "(χ i. if  i ∈ FVO ODE then sol t $ i else ab $ i)"]
                unfolding Vagree_def VSagree_def
                apply(auto) (* 2 subgoals *)
                subgoal for i
                  apply(cases "Inl i ∈ BVO ODE")
                   using bvo_to_fvo[of i ODE] apply (metis (no_types, lifting))
                  apply(erule allE[where x=i])+
                  using Inl_Inr_False imageE ode_to_fvo 
                proof -
                  assume a1: "(aa, ba) = mk_v I ODE (ab, bb) (sol t)"
                  assume a2: "(Inl i ∈ BVO ODE ⟶ sol 0 $ i = ab $ i) ∧ ( Inl i ∈ Inl ` FVO ODE ⟶ sol 0 $ i = ab $ i) ∧ (Inl i ∈ FVF φ ⟶ sol 0 $ i = ab $ i)"
                  assume a3: "(Inl i::'c + 'c) ∉ Inl ` ODE_vars I ODE ∧ Inl i ∉ Inr ` ODE_vars I ODE ⟶ fst (mk_v I ODE (ab, bb) (sol t)) $ i = ab $ i"
                  assume a4: "(Inl i::'c + 'c) ∉ Inl ` ODE_vars I ODE ∧ Inl i ∉ Inr ` ODE_vars I ODE ⟶ fst (mk_v I ODE (χ i. if i ∈ FVO ODE then sol 0 $ i else ab $ i, bb) (χ i. if  i ∈ FVO ODE then sol t $ i else ab $ i)) $ i = (if  i ∈ FVO ODE then sol 0 $ i else ab $ i)"
                  assume a5: "((Inl i::'c + 'c) ∈ Inl ` ODE_vars I ODE ⟶ fst (mk_v I ODE (ab, bb) (sol t)) $ i = sol t $ i) ∧ (Inl i ∈ Inr ` ODE_vars I ODE ⟶ fst (mk_v I ODE (ab, bb) (sol t)) $ i = sol t $ i)"
                  assume a6: "((Inl i::'c + 'c) ∈ Inl ` ODE_vars I ODE ⟶ fst (mk_v I ODE (χ i. if  i ∈ FVO ODE then sol 0 $ i else ab $ i, bb) (χ i. if  i ∈ FVO ODE then sol t $ i else ab $ i)) $ i = (if  i ∈ FVO ODE then sol t $ i else ab $ i)) ∧ (Inl i ∈ Inr ` ODE_vars I ODE ⟶ fst (mk_v I ODE (χ i. if  i ∈ FVO ODE then sol 0 $ i else ab $ i, bb) (χ i. if  i ∈ FVO ODE then sol t $ i else ab $ i)) $ i = (if  i ∈ FVO ODE then sol t $ i else ab $ i))"
                  have f7: "fst (aa, ba) $ i = sol t $ i ∨ (Inl i::'c + 'c) ∉ Inl ` ODE_vars I ODE"
                    using a5 a1 by auto
                  have f8: "fst (aa, ba) $ i = ab $ i ∨ (Inl i::'c + 'c) ∈ Inl ` ODE_vars I ODE"
                    using a3 a1 by fastforce
                  moreover
                  { assume "fst (mk_v I ODE (χ c. if  c ∈ FVO ODE then sol 0 $ c else ab $ c, bb) (χ c. if  c ∈ FVO ODE then sol t $ c else ab $ c)) $ i ≠ ab $ i"
                    { assume "fst (mk_v I ODE (χ c. if  c ∈ FVO ODE then sol 0 $ c else ab $ c, bb) (χ c. if  c ∈ FVO ODE then sol t $ c else ab $ c)) $ i ≠ ab $ i ∧ Inl i ∉ Inr ` ODE_vars I ODE"
                      have " i ∈ FVO ODE ∧ fst (aa, ba) $ i = ab $ i ⟶ fst (mk_v I ODE (χ c. if  c ∈ FVO ODE then sol 0 $ c else ab $ c, bb) (χ c. if  c ∈ FVO ODE then sol t $ c else ab $ c)) $ i ≠ sol t $ i ∧ (Inl i::'c + 'c) ∈ Inl ` ODE_vars I ODE ∨ fst (mk_v I ODE (χ c. if  c ∈ FVO ODE then sol 0 $ c else ab $ c, bb) (χ c. if  c ∈ FVO ODE then sol t $ c else ab $ c)) $ i = ab $ i"
                        using f7 a4 a2 by force }
                    then have " i ∈ FVO ODE ∧ fst (aa, ba) $ i = ab $ i ⟶ fst (mk_v I ODE (χ c. if  c ∈ FVO ODE then sol 0 $ c else ab $ c, bb) (χ c. if  c ∈ FVO ODE then sol t $ c else ab $ c)) $ i ≠ sol t $ i ∧ (Inl i::'c + 'c) ∈ Inl ` ODE_vars I ODE ∨ fst (mk_v I ODE (χ c. if  c ∈ FVO ODE then sol 0 $ c else ab $ c, bb) (χ c. if  c ∈ FVO ODE then sol t $ c else ab $ c)) $ i = ab $ i"
                      by blast }
                  ultimately have " i ∈ FVO ODE ⟶ fst (mk_v I ODE (χ c. if  c ∈ FVO ODE then sol 0 $ c else ab $ c, bb) (χ c. if  c ∈ FVO ODE then sol t $ c else ab $ c)) $ i = fst (aa, ba) $ i"
                    using f7 a6 by fastforce
                  then have "fst (mk_v I ODE (χ c. if  c ∈ FVO ODE then sol 0 $ c else ab $ c, bb) (χ c. if  c ∈ FVO ODE then sol t $ c else ab $ c)) $ i = fst (aa, ba) $ i"
                    using f8 a4 ode_to_fvo by fastforce
                  then show ?thesis
                    using a1 by presburger
                qed
              proof -
                fix i :: 'c
                assume a1: "osafe ODE"
                assume a2: "(aa, ba) = mk_v I ODE (ab, bb) (sol t)"
                assume a3: "∀i. (Inr i ∈ Inl ` ODE_vars I ODE ⟶ snd (mk_v I ODE (χ i. if  i ∈ FVO ODE then sol 0 $ i else ab $ i, bb) (χ i. if  i ∈ FVO ODE then sol t $ i else ab $ i)) $ i = ODE_sem I ODE (χ i. if  i ∈ FVO ODE then sol t $ i else ab $ i) $ i) ∧ ((Inr i::'c + 'c) ∈ Inr ` ODE_vars I ODE ⟶ snd (mk_v I ODE (χ i. if  i ∈ FVO ODE then sol 0 $ i else ab $ i, bb) (χ i. if  i ∈ FVO ODE then sol t $ i else ab $ i)) $ i = ODE_sem I ODE (χ i. if  i ∈ FVO ODE then sol t $ i else ab $ i) $ i)"
                assume a4: "∀i. (Inr i ∈ Inl ` ODE_vars I ODE ⟶ snd (mk_v I ODE (ab, bb) (sol t)) $ i = ODE_sem I ODE (sol t) $ i) ∧ ((Inr i::'c + 'c) ∈ Inr ` ODE_vars I ODE ⟶ snd (mk_v I ODE (ab, bb) (sol t)) $ i = ODE_sem I ODE (sol t) $ i)"
                assume a5: "∀i. Inr i ∉ Inl ` ODE_vars I ODE ∧ (Inr i::'c + 'c) ∉ Inr ` ODE_vars I ODE ⟶ snd (mk_v I ODE (χ i. if  i ∈ FVO ODE then sol 0 $ i else ab $ i, bb) (χ i. if  i ∈ FVO ODE then sol t $ i else ab $ i)) $ i = bb $ i"
                assume a6: "∀i. Inr i ∉ Inl ` ODE_vars I ODE ∧ (Inr i::'c + 'c) ∉ Inr ` ODE_vars I ODE ⟶ snd (mk_v I ODE (ab, bb) (sol t)) $ i = bb $ i"
                have "⋀i f r v. ODE_sem (i::('a, 'b, 'c) interp) ODE (χ c. if  c ∈ FVO ODE then f (r::real) $ c else v $ c) = ODE_sem i ODE (f r)"
                  using a1 by (metis (no_types) alt_sem_lemma)
                moreover
                { assume "(Inr i::'c + 'c) ∉ Inr ` ODE_vars I ODE"
                  moreover
                  { assume "(Inr i::'c + 'c) ∉ Inr ` ODE_vars I ODE ∧ Inr i ∉ Inl ` ODE_vars I ODE ∧ (Inr i::'c + 'c) ∉ Inr ` ODE_vars I ODE ∧ Inr i ∉ Inl ` ODE_vars I ODE"
                    then have "snd (aa, ba) $ i = bb $ i ∧ (Inr i::'c + 'c) ∉ Inr ` ODE_vars I ODE ∧ Inr i ∉ Inl ` ODE_vars I ODE"
                      using a6 a2 by presburger
                    then have "snd (mk_v I ODE (χ c. if  c ∈ FVO ODE then sol 0 $ c else ab $ c, bb) (χ c. if  c ∈ FVO ODE then sol t $ c else ab $ c)) $ i = snd (aa, ba) $ i"
                      using a5 by presburger }
                  ultimately have "snd (mk_v I ODE (χ c. if  c ∈ FVO ODE then sol 0 $ c else ab $ c, bb) (χ c. if  c ∈ FVO ODE then sol t $ c else ab $ c)) $ i = snd (aa, ba) $ i"
                    by blast }
                ultimately show "snd (mk_v I ODE (ab, bb) (sol t)) $ i = snd (mk_v I ODE (χ c. if  c ∈ FVO ODE then sol 0 $ c else ab $ c, bb) (χ c. if  c ∈ FVO ODE then sol t $ c else ab $ c)) $ i"
                  using a4 a3 a2 by fastforce
              qed
            apply(rule conjI)
             subgoal by auto
            apply(auto simp only: solves_ode_def has_vderiv_on_def has_vector_derivative_def)
             apply (rule has_derivative_vec[THEN has_derivative_eq_rhs])
              defer
              apply (rule ext)
              apply (subst scaleR_vec_def)
              apply (rule refl)
             subgoal for x unfolding VSagree_def apply auto
             proof - 
               assume osafe:"osafe ODE"
                 and fsafe:"fsafe φ"
                 and eqP:"P = φ"
                 and aaba: "(aa, ba) = mk_v I ODE (ab, bb) (sol t)"
                 and all:"∀i. (Inl i ∈ BVO ODE ⟶ sol 0 $ i = ab $ i) ∧ (Inl i ∈ Inl ` FVO ODE ⟶ sol 0 $ i = ab $ i) ∧ (Inl i ∈ FVF φ ⟶ sol 0 $ i = ab $ i)"
                 and allSol:"∀x∈{0..t}. (sol has_derivative (λxa. xa *⇩_R ODE_sem I ODE (sol x))) (at x within {0..t})"
                 and mkV:"sol ∈ {0..t} → {x. mk_v I ODE (ab, bb) x ∈ fml_sem I φ}"
                 and x:"0 ≤ x" 
                 and t:"x ≤ t"
               from all have allT:"⋀s. s ≥ 0 ⟹ s ≤ t ⟹ mk_v I ODE (ab,bb) (sol s) ∈ fml_sem I φ"
                 using mkV by auto
               have VA:"⋀x. Vagree (mk_v I ODE (ab, bb) (sol x)) (mk_v I ODE (ab, bb) (χ i. if  i ∈ FVO ODE then sol x $ i else ab $ i))
                   (FVF φ)"
                 unfolding Vagree_def
                 apply(auto) (* 2 subgoals *)
                 subgoal for xa i
                   using mk_v_agree[of I ODE "(ab,bb)" "sol xa"] 
                         mk_v_agree[of I ODE "(ab,bb)" "(χ i. if  i ∈ FVO ODE then sol xa $ i else ab $ i)"]
                   apply(cases "i ∈ ODE_vars I ODE")
                   using ode_to_fvo [of i I ODE] unfolding Vagree_def 
                   apply auto
                   by fastforce
                 subgoal for xa i
                   using mk_v_agree[of I ODE "(ab,bb)" "sol xa"] 
                       mk_v_agree[of I ODE "(ab,bb)" "(χ i. if  i ∈ FVO ODE then sol xa $ i else ab $ i)"]
                       ODE_vars_lr
                   using ode_to_fvo[of i I ODE] unfolding Vagree_def apply auto
                   using alt_sem_lemma osafe
                   subgoal
                   proof -
                     assume a1: "∀i. Inr i ∉ Inl ` ODE_vars I ODE ∧ (Inr i::'c + 'c) ∉ Inr ` ODE_vars I ODE ⟶ snd (mk_v I ODE (ab, bb) (sol xa)) $ i = bb $ i"
                     assume a2: "∀i. Inr i ∉ Inl ` ODE_vars I ODE ∧ (Inr i::'c + 'c) ∉ Inr ` ODE_vars I ODE ⟶ snd (mk_v I ODE (ab, bb) (χ i. if  i ∈ FVO ODE then sol xa $ i else ab $ i)) $ i = bb $ i"
                     assume a3: "∀i. (Inr i ∈ Inl ` ODE_vars I ODE ⟶ snd (mk_v I ODE (ab, bb) (sol xa)) $ i = ODE_sem I ODE (sol xa) $ i) ∧ ((Inr i::'c + 'c) ∈ Inr ` ODE_vars I ODE ⟶ snd (mk_v I ODE (ab, bb) (sol xa)) $ i = ODE_sem I ODE (sol xa) $ i)"
                     assume a4: "∀i. (Inr i ∈ Inl ` ODE_vars I ODE ⟶ snd (mk_v I ODE (ab, bb) (χ i. if  i ∈ FVO ODE then sol xa $ i else ab $ i)) $ i = ODE_sem I ODE (χ i. if  i ∈ FVO ODE then sol xa $ i else ab $ i) $ i) ∧ ((Inr i::'c + 'c) ∈ Inr ` ODE_vars I ODE ⟶ snd (mk_v I ODE (ab, bb) (χ i. if  i ∈ FVO ODE then sol xa $ i else ab $ i)) $ i = ODE_sem I ODE (χ i. if  i ∈ FVO ODE then sol xa $ i else ab $ i) $ i)"
                     have "ODE_sem I ODE (χ c. if  c ∈ FVO ODE then sol xa $ c else ab $ c) $ i = ODE_sem I ODE (sol xa) $ i"
                       by (metis (no_types) alt_sem_lemma osafe)
                     then have "Inr i ∉ Inl ` ODE_vars I ODE ∧ (Inr i::'c + 'c) ∉ Inr ` ODE_vars I ODE ∨ snd (mk_v I ODE (ab, bb) (sol xa)) $ i = snd (mk_v I ODE (ab, bb) (χ c. if  c ∈ FVO ODE then sol xa $ c else ab $ c)) $ i"
                       using a4 a3 by fastforce
                     then show ?thesis
                       using a2 a1 by presburger
                   qed
                   done
                 done
                 note sem = IHF[OF Iagree_refl[of I]]       
                 have VA1:"(∀i. Inl i ∈ FVF φ ⟶
                         fst (mk_v I ODE ((χ i. if  i ∈ FVO ODE then sol 0 $ i else ab $ i), bb) (χ i. if  i ∈ FVO ODE then sol x $ i else ab $ i)) $ i 
                       = fst (mk_v I ODE (ab, bb) (sol x)) $ i)"
                   and VA2: "(∀i. Inr i ∈ FVF φ ⟶ 
                         snd (mk_v I ODE ((χ i. if  i ∈ FVO ODE then sol 0 $ i else ab $ i), bb) (χ i. if  i ∈ FVO ODE then sol x $ i else ab $ i)) $ i 
                       = snd (mk_v I ODE (ab, bb) (sol x)) $ i)"
                   apply(auto) (* 2 subgoals *)
                   subgoal for i
                     using mk_v_agree[of I ODE "((χ i. if  i ∈ FVO ODE then sol 0 $ i else ab $ i),bb)" "(χ i. if  i ∈ FVO ODE then sol x $ i else ab $ i)"]
                     using mk_v_agree[of I ODE "(ab,bb)" "(sol x)"] ODE_vars_lr[of i I ODE]
                     unfolding Vagree_def apply (auto)
                      apply(erule allE[where x=i])+
                      apply(cases " i ∈ FVO ODE")
                       apply(auto)
                       apply(cases " i ∈ FVO ODE") (* 18 subgoals *)
                       apply(auto)
                       using ODE_vars_lr[of i I ODE] ode_to_fvo[of i I ODE]
                       apply auto
                      using all by meson
                   subgoal for i
                     using mk_v_agree[of I ODE "((χ i. if  i ∈ FVO ODE then sol 0 $ i else ab $ i),bb)" "(χ i. if  i ∈ FVO ODE then sol x $ i else ab $ i)"]
                     using mk_v_agree[of I ODE "(ab,bb)" "(sol x)"] ODE_vars_lr[of i I ODE]
                     unfolding Vagree_def apply (auto)
                     apply(erule allE[where x=i])+
                     apply(cases " i ∈ FVO ODE")
                      apply(auto) (*  32 subgoals *)
                      apply(cases " i ∈ FVO ODE")
                       apply(auto)
                      using ODE_vars_lr[of i I ODE] ode_to_fvo[of i I ODE]
                      apply(auto)
                      using alt_sem_lemma osafe
                      by (metis (no_types) alt_sem_lemma osafe)+
                   done               
                 show "mk_v I ODE (χ i. if  i ∈ FVO ODE then sol 0 $ i else ab $ i, bb)
                                  (χ i. if  i ∈ FVO ODE then sol x $ i else ab $ i) ∈ fml_sem I φ"
                   using mk_v_agree[of I ODE "(χ i. if  i ∈ FVO ODE then sol 0 $ i else ab $ i, bb)" 
                                             "(χ i. if  i ∈ FVO ODE then sol x $ i else ab $ i)"]
                      mk_v_agree[of I ODE "(ab, bb)" "sol x"]
                   using sem[of "mk_v I ODE (χ i. if  i ∈ FVO ODE then sol 0 $ i else ab $ i, bb) (χ i. if  i ∈ FVO ODE then sol x $ i else ab $ i)"
                                "mk_v I ODE (ab, bb) (sol x)"]
                   VA1 VA2
                   allT[of x] allT[of 0]
                   unfolding Vagree_def
                   apply auto
                   using atLeastAtMost_iff mem_Collect_eq mkV t x
                   apply(auto)
                   using eqP VA sem
                   by auto
               qed
               proof -
                 fix x i 
                 assume 
                   assms:"osafe ODE"
                   "fsafe φ"
                   "0 ≤ t"
                   "(aa, ba) = mk_v I ODE (ab, bb) (sol t)"
                   "VSagree (sol 0) ab {x. Inl x ∈ BVO ODE ∨ Inl x ∈ Inl ` FVO ODE ∨ Inl x ∈ FVF φ}"
                   and deriv:"∀x∈{0..t}. (sol has_derivative (λxa. xa *⇩_R ODE_sem I ODE (sol x))) (at x within {0..t})"
                   and sol:"sol ∈ {0..t} → {x. mk_v I ODE (ab, bb) x ∈ fml_sem I φ}"
                   and mem:"x ∈ {0..t}"
                 from deriv 
                 have xDeriv:"(sol has_derivative (λxa. xa *⇩_R ODE_sem I ODE (sol x))) (at x within {0..t})"
                   using mem by blast
                 have silly1:"(λx. χ i. sol x $ i) = sol"
                   by (auto simp add: vec_eq_iff)
                 have silly2:"(λh. χ i. h * ODE_sem I ODE (sol x) $ i) = (λxa. xa *⇩_R ODE_sem I ODE (sol x))"
                   by (auto simp add: vec_eq_iff)
                 from xDeriv have 
                   xDeriv':"((λx. χ i. sol x $ i) has_derivative (λh. χ i. h * ODE_sem I ODE (sol x) $ i)) (at x within {0..t})"
                   using silly1 silly2 apply auto done
                 from xDeriv have xDerivs:"⋀j. ((λt. sol t $ j) has_derivative (λxa. (xa *⇩_R ODE_sem I ODE (sol x)) $ j)) (at x within {0..t})"
                   subgoal for j
                     using silly1 silly2 has_derivative_proj[of "(λi. λt. sol t $ i)" "(λ i. λxa. (xa *⇩_R ODE_sem I ODE (sol x)) $ i)" "(at x within {0..t})" j]
                     apply auto
                     done
                   done
                 have neato:"⋀ν.  i ∉ FVO ODE ⟹ ODE_sem I ODE ν $ i = 0"
                 proof (induction "ODE")
                 qed auto
                 show "((λt. if  i ∈ FVO ODE then sol t $ i else ab $ i) has_derivative
                 (λh. h *⇩_R ODE_sem I ODE (χ i. if  i ∈ FVO ODE then sol x $ i else ab $ i) $ i))
                 (at x within {0..t})"
                   using assms sol mem
                   apply auto
                   apply (rule has_derivative_eq_rhs)
                    unfolding VSagree_def apply auto
                   apply(cases " i ∈ FVO ODE")
                    using xDerivs[of i] apply auto 
                    using alt_sem_lemma neato[of "(χ i. if  i ∈ FVO ODE then sol x $ i else ab $ i)"] apply auto 
                 proof -
                   assume a1: "((λt. sol t $ i) has_derivative (λxa. xa * ODE_sem I ODE (sol x) $ i)) (at x within {0..t})"
                   have "⋀i r. ODE_sem (i::('a, 'b, 'c) interp) ODE (χ c. if  c ∈ FVO ODE then sol r $ c else ab $ c) = ODE_sem i ODE (sol r)"
                     by (metis (no_types) alt_sem_lemma assms(1))
                   then show "((λr. sol r $ i) has_derivative (λr. r * ODE_sem I ODE (χ c. if  c ∈ FVO ODE then sol x $ c else ab $ c) $ i)) (at x within {0..t})"
                     using a1 by presburger
                 qed
               qed
               proof -
                 fix aa ba bb sol t
                 assume osafe:"osafe ODE"
                   and fsafe:"fsafe φ"
                   and t:"0 ≤ t"
                   and aaba:"(aa, ba) = mk_v I ODE (sol 0, bb) (sol t)"
                   and sol:"(sol solves_ode (λa. ODE_sem I ODE)) {0..t} {x. mk_v I ODE (sol 0, bb) x ∈ fml_sem I φ}"
                 show"∃sola ta. mk_v I ODE (sol 0, bb) (sol t) = mk_v I ODE (sol 0, bb) (sola ta) ∧
                           0 ≤ ta ∧
                           (sola solves_ode (λa. ODE_sem I ODE)) {0..ta} {x. mk_v I ODE (sol 0, bb) x ∈ fml_sem I φ} ∧
                           VSagree (sola 0) (sol 0) {x. Inl x ∈ BVO ODE ∨ Inl x ∈ Inl ` FVO ODE ∨ Inl x ∈ FVF φ}"   
                   apply(rule exI[where x=sol])
                   apply(rule exI[where x=t])
                   using fsafe t aaba sol apply auto
                   unfolding VSagree_def by auto
                 qed
               done
             done
           show "∀I J. coincide_hp (EvolveODE ODE P) I J ∧ ode_sem_equiv (EvolveODE ODE P) I"
                proof (rule allI)+
                  fix I J::"('a,'b,'c) interp"      
                from equiv[of I] 
                have equivI:"
            {(ν, mk_v I ODE ν (sol t)) | ν sol t.
                t ≥ 0 ∧
                (sol solves_ode (λ_. ODE_sem I ODE)) {0..t} {x. mk_v I ODE ν x ∈ fml_sem I P} ∧
                VSagree (sol 0) (fst ν) {x | x. Inl x ∈ FVP (EvolveODE ODE P)}} = 
            {(ν, mk_v I ODE ν (sol t)) | ν sol t.
                t ≥ 0 ∧
                (sol solves_ode (λ_. ODE_sem I ODE)) {0..t} {x. mk_v I ODE ν x ∈ fml_sem I P} ∧
                 (sol 0) = (fst ν)}"
                  unfolding ode_sem_equiv_def using osafe fsafe by blast
                
                from equiv[of J] 
                have equivJ:"
            {(ν, mk_v J ODE ν (sol t)) | ν sol t.
                t ≥ 0 ∧
                (sol solves_ode (λ_. ODE_sem J ODE)) {0..t} {x. mk_v J ODE ν x ∈ fml_sem J P} ∧
                VSagree (sol 0) (fst ν) {x | x. Inl x ∈ FVP (EvolveODE ODE P)}} = 
            {(ν, mk_v J ODE ν (sol t)) | ν sol t.
                t ≥ 0 ∧
                (sol solves_ode (λ_. ODE_sem J ODE)) {0..t} {x. mk_v J ODE ν x ∈ fml_sem J P} ∧
                (sol 0) = (fst ν)}"
                  unfolding ode_sem_equiv_def using osafe fsafe by blast
                from equivI 
                have alt_ode_semI:"prog_sem I (EvolveODE ODE P) = 
                  {(ν, mk_v I ODE ν (sol t)) | ν sol t.
                t ≥ 0 ∧
                (sol solves_ode (λ_. ODE_sem I ODE)) {0..t} {x. mk_v I ODE ν x ∈ fml_sem I P} ∧
                VSagree (sol 0) (fst ν) {x | x. Inl x ∈ FVP (EvolveODE ODE P)}}" by auto
                
                from equivJ 
                have alt_ode_semJ:"prog_sem J (EvolveODE ODE P) = 
                  {(ν, mk_v J ODE ν (sol t)) | ν sol t.
                t ≥ 0 ∧
                (sol solves_ode (λ_. ODE_sem J ODE)) {0..t} {x. mk_v J ODE ν x ∈ fml_sem J P} ∧
                VSagree (sol 0) (fst ν) {x | x. Inl x ∈ FVP (EvolveODE ODE P)}}" by auto
                
                have co_hp:"coincide_hp (EvolveODE ODE P) I J"
                  apply(unfold coincide_hp_def)
                  apply (auto simp del: prog_sem.simps(8) simp add: alt_ode_semI  alt_ode_semJ)
                  proof -
                fix a b aa ba ab bb V sol t
                 from IH have IHF:"∀a b aa ba . Iagree I J (SIGF P) ⟶ Vagree (a, b) (aa, ba) (FVF P) ⟶ ((a, b) ∈ fml_sem I P) = ((aa, ba) ∈ fml_sem J P)"
                   unfolding coincide_fml_def by blast
                 assume IA:"Iagree I J (SIGF P ∪ {Inl x |x. Inl x ∈ SIGO ODE} ∪ {Inr (Inr x) |x. Inr x ∈ SIGO ODE})"
                 and VA:"Vagree (a, b) (aa, ba) V"
                 and OVsub:"BVO ODE ⊆ V"
                 and Osub:"Inl ` FVO ODE ⊆ V"
                 and Fsub:"FVF P ⊆ V"
                 and veq:"(ab, bb) = mk_v I ODE (a, b) (sol t)"
                 and t:"0 ≤ t"
                 and sol:"(sol solves_ode (λa. ODE_sem I ODE)) {0..t} {x. mk_v I ODE (a, b) x ∈ fml_sem I P}"
                 and VSA:"VSagree (sol 0) a  {uu. Inl uu ∈ BVO ODE ∨ Inl uu ∈ Inl ` FVO ODE ∨ Inl uu ∈ FVF P}"
                 have semBVsub:"(semBV I ODE) ⊆ BVO ODE" 
                   by (induction ODE, auto)
                 then have OVsub'':"(semBV I ODE) ⊆ V" using OVsub by auto
                 have MBVBVsub:"(Inl ` ODE_dom ODE ∪ Inr ` ODE_dom ODE) ⊆ BVO ODE"
                   apply(induction ODE)
                   by auto
                 from OVsub and MBVBVsub have OVsub':"(Inl ` ODE_dom ODE ∪ Inr ` ODE_dom ODE) ⊆ V"
                   by auto
                from sol 
                have  solSem:"⋀x. 0 ≤ x ⟹ x ≤ t ⟹ mk_v I ODE (a, b) (sol x) ∈ fml_sem I P"
                  and solDeriv:"⋀x. 0 ≤ x ⟹ x ≤ t ⟹ (sol has_vector_derivative ODE_sem I ODE (sol x)) (at x within {0..t})"
                  unfolding solves_ode_def has_vderiv_on_def by auto
                have SIGFsub:"(SIGF P) ⊆ (SIGF P ∪ {Inl x |x. Inl x ∈ SIGO ODE} ∪ {Inr (Inr x) |x. Inr x ∈ SIGO ODE})" by auto
                from IA have IAP:"Iagree I J (SIGF P)"
                  using Iagree_sub[OF SIGFsub] by auto
                from IHF have IH':
                  "∀a b aa ba. Vagree (a, b) (aa, ba) (FVF P) ⟶ ((a, b) ∈ fml_sem I P) = ((aa, ba) ∈ fml_sem J P)"
                  using IAP by blast
                from VA 
                have VAOV:"Vagree (a,b) (aa,ba) (BVO ODE)"
                  using agree_sub[OF OVsub] by auto
                have ag:"⋀s. Vagree (mk_v I ODE (a, b) (sol s)) (a, b) (- semBV I ODE)" 
                     "⋀s. Vagree (mk_v I ODE (a, b) (sol s)) (mk_xode I ODE (sol s)) (semBV I ODE)"
                     "⋀s. Vagree (mk_v J ODE (aa, ba) (sol s)) (aa, ba) (- semBV J ODE)"
                     "⋀s. Vagree (mk_v J ODE (aa, ba) (sol s)) (mk_xode J ODE (sol s)) (semBV J ODE)"
                  subgoal for s using mk_v_agree[of I ODE "(a,b)" "sol s"] by auto
                  subgoal for s using mk_v_agree[of I ODE "(a,b)" "sol s"] by auto
                  subgoal for s using mk_v_agree[of J ODE "(aa,ba)" "sol s"] by auto
                  subgoal for s using mk_v_agree[of J ODE "(aa,ba)" "sol s"] by auto
                  done  
                have sem_sub_BVO:"⋀I. semBV I ODE ⊆ BVO ODE"
                  subgoal for I
                    apply(induction ODE)
                    by auto
                  done
                have MBV_sub_sem:"⋀I. (Inl ` ODE_dom ODE ∪ Inr ` ODE_dom ODE) ⊆ semBV I ODE"
                  subgoal for I by (induction ODE, auto) done
                have ag_BVO:
                  "⋀s. Vagree (mk_v I ODE (a, b) (sol s)) (a, b) (- BVO ODE)"
                  "⋀s. Vagree (mk_v J ODE (aa, ba) (sol s)) (aa, ba) (- BVO ODE)"
                  using ag(1) ag(3)  sem_sub_BVO[of I] sem_sub_BVO[of J] agree_sub by blast+
                have ag_semBV:
                     "⋀s. Vagree (mk_v I ODE (a, b) (sol s)) (mk_xode I ODE (sol s)) (Inl ` ODE_dom ODE ∪ Inr ` ODE_dom ODE)"
                     "⋀s. Vagree (mk_v J ODE (aa, ba) (sol s)) (mk_xode J ODE (sol s)) (Inl ` ODE_dom ODE ∪ Inr ` ODE_dom ODE)"
                  using ag(2) ag(4)  MBV_sub_sem[of I] MBV_sub_sem[of J]
                  by (simp add: agree_sub)+
                have IOsub:"({Inl x |x. Inl x ∈ SIGO ODE} ∪ {Inr (Inr x) |x. Inr x ∈ SIGO ODE}) ⊆ (SIGF P ∪ {Inl x |x. Inl x ∈ SIGO ODE} ∪ {Inr (Inr x) |x. Inr x ∈ SIGO ODE})"
                  by auto
                from IA 
                have IAO:"Iagree I J ({Inl x |x. Inl x ∈ SIGO ODE} ∪ {Inr (Inr x) |x. Inr x ∈ SIGO ODE})"
                  using Iagree_sub[OF IOsub] by auto
                have IOsub':"({Inr (Inr x) |x. Inr x ∈ SIGO ODE}) ⊆ ({Inl x |x. Inl x ∈ SIGO ODE} ∪ {Inr (Inr x) |x. Inr x ∈ SIGO ODE})"
                  by auto
                from IAO
                have IAO':"Iagree I J ({Inr (Inr x) |x. Inr x ∈ SIGO ODE})"
                  using Iagree_sub[OF IOsub'] by auto
                have VAsol:"⋀s ν'. Vagree ((sol s), ν') ((sol s), ν')  (Inl `FVO ODE)" unfolding Vagree_def by auto
                have Osem:"⋀s. 0 ≤ s ⟹ s ≤ t ⟹ ODE_sem I ODE (sol s) = ODE_sem J ODE (sol s)"
                  subgoal for s
                    using coincidence_ode[OF osafe VAsol[of s] IAO] by auto
                  done
                from Osem
                have Oag:"⋀s. 0 ≤ s ⟹ s ≤ t ⟹ VSagree (ODE_sem I ODE (sol s)) (ODE_sem J ODE (sol s)) {x. Inr x ∈ BVO ODE}"
                  unfolding VSagree_def by auto
                from Osem
                have Oagsem:"⋀s. 0 ≤ s ⟹ s ≤ t ⟹ VSagree (ODE_sem I ODE (sol s)) (ODE_sem J ODE (sol s)) {x. Inr x ∈ (semBV I ODE)}"
                  unfolding VSagree_def by auto
                from Osem
                have halp:"⋀s. 0 ≤ s ⟹ s ≤ t ⟹  Vagree (mk_xode I ODE (sol s)) (mk_xode J ODE (sol s)) (semBV I ODE)"
                  apply(auto)
                  using Oag unfolding Vagree_def VSagree_def by blast
                then have halpp:"⋀s. 0 ≤ s ⟹ s ≤ t ⟹ Vagree (sol s, ODE_sem I ODE (sol s)) (sol s, ODE_sem J ODE (sol s)) (semBV I ODE)"
                  by auto
                have eqV:"V = ((semBV I ODE)) ∪ (V ∩ (-(semBV I ODE)))" using OVsub'' by auto
                have neat:"⋀ODE. Iagree I J ({Inr (Inr x) |x. Inr x ∈ SIGO ODE}) ⟹ semBV I ODE = semBV J ODE"
                  subgoal for ODE
                  proof (induction ODE)
                    case (OVar x)
                    then show ?case unfolding Iagree_def by auto
                  next
                    case (OSing x1a x2)
                    then show ?case by auto
                  next
                    case (OProd ODE1 ODE2)
                    assume IH1:"Iagree I J {Inr (Inr x) |x. Inr x ∈ SIGO ODE1} ⟹ semBV I ODE1 = semBV J ODE1"
                    assume IH2:"Iagree I J {Inr (Inr x) |x. Inr x ∈ SIGO ODE2} ⟹ semBV I ODE2 = semBV J ODE2"
                    assume agree:"Iagree I J {Inr (Inr x) |x. Inr x ∈ SIGO (OProd ODE1 ODE2)}"
                    from agree have agree1:"Iagree I J {Inr (Inr x) |x. Inr x ∈ SIGO ( ODE1 )}" and agree2:"Iagree I J {Inr (Inr x) |x. Inr x ∈ SIGO ( ODE2)}"
                      unfolding Iagree_def by auto
                    show ?case using IH1[OF agree1] IH2[OF agree2] by auto
                  qed
                  done
                note semBVeq = neat[OF IAO']
                          then have halpp':"⋀s. 0 ≤ s ⟹ s ≤ t ⟹ Vagree (mk_v I ODE (a, b) (sol s)) (mk_v J ODE (aa, ba) (sol s)) (semBV I ODE)"
                  subgoal for s using ag[of s] ag_semBV[of s] Oagsem agree_trans semBVeq
                      unfolding Vagree_def by (auto simp add: semBVeq Osem)
                  done
                have VAbar:"⋀s. 0 ≤ s ⟹ s ≤ t ⟹ Vagree (mk_v I ODE (a, b) (sol s)) (mk_v J ODE (aa, ba) (sol s)) (V ∩ (-(semBV I ODE)))"
                  subgoal for s
                    apply(unfold Vagree_def)
                    apply(rule conjI | rule allI)+
                    subgoal for i
                      apply auto
                      using VA ag[of s] semBVeq unfolding Vagree_def apply auto 
                      by (metis Un_iff)
                      
                    apply(rule allI)+
                    subgoal for i
                      using VA ag[of s] semBVeq unfolding Vagree_def by auto
                    done
                  done
                have VAfoo:"⋀s. 0 ≤ s ⟹ s ≤ t ⟹ Vagree (mk_v I ODE (a, b) (sol s)) (mk_v J ODE (aa, ba) (sol s)) V"
                  using agree_union[OF halpp' VAbar] eqV by auto
                have duhSub:"FVF P ⊆ UNIV" by auto
                from VAfoo 
                have VA'foo:"⋀s. 0 ≤ s ⟹ s ≤ t ⟹ Vagree (mk_v I ODE (a, b) (sol s)) (mk_v J ODE (aa, ba) (sol s)) V"
                  using agree_sub[OF duhSub] by auto
                then have VA''foo:"⋀s. 0 ≤ s ⟹ s ≤ t ⟹ Vagree (mk_v I ODE (a, b) (sol s)) (mk_v J ODE (aa, ba) (sol s)) (FVF P)"
                  using agree_sub[OF Fsub] by auto
                from VA''foo IH' 
                have fmlSem:"⋀s. 0 ≤ s ⟹ s ≤ t ⟹ (mk_v I ODE (a, b) (sol s)) ∈ fml_sem I P ⟷ (mk_v J ODE (aa, ba) (sol s)) ∈ fml_sem J P"
                  using IAP coincide_fml_def hpsafe_Evolve.IH by blast
                from VA 
                have VAO:"Vagree (a, b) (aa, ba) (Inl `FVO ODE)" 
                  using agree_sub[OF Osub] by auto
                have sol':"(sol solves_ode (λ_. ODE_sem J ODE)) {0..t} {x. mk_v J ODE (aa, ba) x ∈ fml_sem J P}"
                  apply(auto simp add: solves_ode_def has_vderiv_on_def)
                  subgoal for s
                    using solDeriv[of s] Osem[of s] by auto
                  subgoal for s
                    using solSem[of s] fmlSem[of s] by auto
                  done
                have VSA':"VSagree (sol 0) aa {uu. Inl uu ∈ BVO ODE ∨ Inl uu ∈ Inl `FVO ODE ∨ Inl uu ∈ FVF P}"
                  using VSA VA OVsub unfolding VSagree_def Vagree_def
                  apply auto
                  using Osub apply blast
                  using Fsub by blast
                show
                  " ∃ab bb. (∃sol t. (ab, bb) = mk_v J ODE (aa, ba) (sol t) ∧
                                  0 ≤ t ∧
                                  (sol solves_ode (λa. ODE_sem J ODE)) {0..t} {x. mk_v J ODE (aa, ba) x ∈ fml_sem J P} ∧
                                  VSagree (sol 0) aa {uu. Inl uu ∈ BVO ODE ∨ Inl uu ∈ Inl `FVO ODE ∨ Inl uu ∈ FVF P}) ∧
                         Vagree (mk_v I ODE (a, b) (sol t)) (ab, bb) (Inl ` ODE_dom ODE ∪ Inr ` ODE_dom ODE ∪ V) "
                  apply(rule exI[where x="fst (mk_v J ODE (aa, ba) (sol t))"])
                  apply(rule exI[where x="snd (mk_v J ODE (aa, ba) (sol t))"])
                  apply(rule conjI)
                  subgoal
                    apply(rule exI[where x="sol"])
                    apply(rule exI[where x=t])
                    apply(rule conjI)
                    subgoal
                      apply(auto)
                      done
                    subgoal
                      apply(rule conjI)
                      subgoal by (rule t)
                      subgoal
                        apply(rule conjI)
                        subgoal by (rule sol')
                        subgoal by (rule VSA')
                      done
                    done
                  done
                apply(auto)
                using mk_v_agree[of I ODE "(a,b)" "(sol t)"]
                      mk_v_agree[of J ODE "(aa,ba)" "(sol t)"]
                using agree_refl t VA'foo 
                OVsub' Un_absorb1 by (auto simp add: OVsub' Un_absorb1)
              qed
      show "coincide_hp (EvolveODE ODE P) I J ∧ ode_sem_equiv (EvolveODE ODE P) I" using co_hp equiv[of I] by auto
    qed
  qed
next
  case (hpsafe_Choice a b) 
  then show "?case" 
proof (auto simp only: coincide_hp'_def coincide_hp_def)
  fix I J::"('a,'b,'c) interp" and ν1 ν1' ν2 ν2' μ μ' V
  assume safe:"hpsafe a"
     "hpsafe b"
    and IH1:"
     ∀ I J. (∀ν ν' μ V.
        Iagree I J (SIGP a) ⟶
        Vagree ν ν' V ⟶ FVP a ⊆ V ⟶ (ν, μ) ∈ prog_sem I a ⟶ (∃μ'. (ν', μ') ∈ prog_sem J a ∧ Vagree μ μ' (MBV a ∪ V)))
        ∧ ode_sem_equiv a I"
    and IH2:"∀ I J. (∀ν ν' μ V.
        Iagree I J (SIGP b) ⟶
        Vagree ν ν' V ⟶ FVP b ⊆ V ⟶ (ν, μ) ∈ prog_sem I b ⟶ (∃μ'. (ν', μ') ∈ prog_sem J b ∧ Vagree μ μ' (MBV b ∪ V)))
        ∧ ode_sem_equiv b I"
    and IA:"Iagree I J (SIGP (a ∪∪ b))"
    and VA:"Vagree (ν1, ν1') (ν2, ν2') V"
    and sub:"FVP (a ∪∪ b) ⊆ V"
    and sem:"((ν1, ν1'), (μ, μ')) ∈ prog_sem I (a ∪∪ b)"
  hence eitherSem:"((ν1, ν1'), (μ, μ')) ∈ prog_sem I a ∨ ((ν1, ν1'), (μ, μ')) ∈ prog_sem I b"
    by auto
  have Ssub:"(SIGP a) ⊆ SIGP (a ∪∪ b)" "(SIGP b) ⊆ SIGP (a ∪∪ b)" 
    unfolding SIGP.simps by auto
  have IA1:"Iagree I J (SIGP a)" and IA2:"Iagree I J (SIGP b)" 
    using IA Iagree_sub[OF Ssub(1)] Iagree_sub[OF Ssub(2)] by auto
  from sub have sub1:"FVP a ⊆ V" and sub2:"FVP b ⊆ V" by auto
  then
  show "∃μ''. ((ν2, ν2'), μ'') ∈ prog_sem J (a ∪∪ b) ∧ Vagree (μ, μ') μ'' (MBV (a ∪∪ b) ∪ V)" 
    proof (cases "((ν1, ν1'), (μ, μ')) ∈ prog_sem I a")
      case True
      then obtain μ'' where prog_sem:"((ν2,ν2'), μ'') ∈ prog_sem J a" and agree:"Vagree (μ, μ') μ'' (MBV a ∪ V)" 
        using IH1 VA sub1 IA1 by blast
      from agree have agree':"Vagree (μ, μ') μ'' (MBV (a ∪∪ b) ∪ V)"
        unfolding Vagree_def MBV.simps by auto
      from prog_sem have prog_sem':"((ν2,ν2'), μ'') ∈ prog_sem J (a ∪∪ b)"
        unfolding prog_sem.simps by blast
      from agree' and prog_sem' show ?thesis by blast
    next
      case False
      then have sem2:"((ν1, ν1'), (μ, μ')) ∈ prog_sem I b" using eitherSem by blast
      then obtain μ'' where prog_sem:"((ν2,ν2'), μ'') ∈ prog_sem J b" and agree:"Vagree (μ, μ') μ'' (MBV b ∪ V)" 
        using IH2 VA sub2 IA2 by blast
      from agree have agree':"Vagree (μ, μ') μ'' (MBV (a ∪∪ b) ∪ V)"
        unfolding Vagree_def MBV.simps by auto
      from prog_sem have prog_sem':"((ν2,ν2'), μ'') ∈ prog_sem J (a ∪∪ b)"
        unfolding prog_sem.simps by blast
      from agree' and prog_sem' show ?thesis by blast
    qed
  next
    fix I
    assume IHs:
      "∀I J. (∀ν ν' μ V.
        Iagree I J (SIGP a) ⟶
        Vagree ν ν' V ⟶ FVP a ⊆ V ⟶ (ν, μ) ∈ prog_sem I a ⟶ (∃μ'. (ν', μ') ∈ prog_sem J a ∧ Vagree μ μ' (MBV a ∪ V))) ∧
        ode_sem_equiv a I"
      "∀I J. (∀ν ν' μ V.
        Iagree I J (SIGP b) ⟶
        Vagree ν ν' V ⟶ FVP b ⊆ V ⟶ (ν, μ) ∈ prog_sem I b ⟶ (∃μ'. (ν', μ') ∈ prog_sem J b ∧ Vagree μ μ' (MBV b ∪ V))) ∧
        ode_sem_equiv b I"     
    show "ode_sem_equiv (a ∪∪ b) I"
      unfolding ode_sem_equiv_def by auto
  qed 
next
  case (hpsafe_Sequence a b) then show "?case"
    apply (unfold coincide_hp'_def coincide_hp_def)
    apply (rule allI)+
    apply (rule conjI)
     prefer 2 subgoal unfolding ode_sem_equiv_def  by auto
    apply(unfold prog_sem.simps SIGP.simps FVP.simps )
    apply(rule allI)+
    apply(auto)
    subgoal for I J  ν2 ν2' V ν1 ν1' μ μ' ω ω' 
    proof -
      assume safe:"hpsafe a" "hpsafe b"
      assume "(∀I. ((∀J. Iagree I J (SIGP a) ⟶ (∀aa b ab ba ac bb V.
         Vagree (aa, b) (ab, ba) V ⟶
         FVP a ⊆ V ⟶ ((aa, b), ac, bb) ∈ prog_sem I a ⟶ (∃aa b. ((ab, ba), aa, b) ∈ prog_sem J a ∧ Vagree (ac, bb) (aa, b) (MBV a ∪ V)))))
          ∧ ode_sem_equiv a I)"
      hence IH1':"⋀aa b ab ba ac bb V.
         Iagree I J (SIGP a) ⟹
         Vagree (aa, b) (ab, ba) V ⟹
         FVP a ⊆ V ⟹ ((aa, b), ac, bb) ∈ prog_sem I a ⟹ (∃aa b. ((ab, ba), aa, b) ∈ prog_sem J a ∧ Vagree (ac, bb) (aa, b) (MBV a ∪ V))"
        by auto
      note IH1 =  IH1'[of ν1 ν1' ν2 ν2' V μ μ']
      assume IH2'':"
        ∀I. (∀J. Iagree I J (SIGP b) ⟶ (∀a ba aa bb ab bc V.
         Vagree (a, ba) (aa, bb) V ⟶
         FVP b ⊆ V ⟶ ((a, ba), ab, bc) ∈ prog_sem I b ⟶ (∃a ba. ((aa, bb), a, ba) ∈ prog_sem J b ∧ Vagree (ab, bc) (a, ba) (MBV b ∪ V))))
         ∧ ode_sem_equiv b I"
      assume IAab:"Iagree I J (SIGP a ∪ SIGP b)"
      have IAsubs:"SIGP a ⊆ (SIGP a ∪ SIGP b)" "SIGP b ⊆ (SIGP a ∪ SIGP b)" by auto
      from IAab have  IA:"Iagree I J (SIGP a)" "Iagree I J (SIGP b)" using Iagree_sub[OF IAsubs(1)] Iagree_sub[OF IAsubs(2)] by auto
      from IH2'' have IH2':"⋀a ba aa bb ab bc V .
         Iagree I J (SIGP b) ⟹
         Vagree (a, ba) (aa, bb) V ⟹
         FVP b ⊆ V ⟹ ((a, ba), ab, bc) ∈ prog_sem I b ⟹ (∃a ba. ((aa, bb), a, ba) ∈ prog_sem J b ∧ Vagree (ab, bc) (a, ba) (MBV b ∪ V))"
        using IA by auto
      assume VA:"Vagree (ν1, ν1') (ν2, ν2') V"
      assume sub:"FVP a ⊆ V" "FVP b - MBV a ⊆ V"
        hence sub':"FVP a ⊆ V" by auto
      assume sem:"((ν1, ν1'), (μ, μ')) ∈ prog_sem I a"
        "((μ, μ'), (ω, ω')) ∈ prog_sem I b"
      obtain ω1 ω1' where sem1:"((ν2, ν2'), (ω1, ω1')) ∈ prog_sem J a" and VA1:"Vagree (μ, μ') (ω1, ω1') (MBV a ∪ V)" 
        using IH1[OF IA(1) VA  sub' sem(1)] by auto
      note IH2 =  IH2'[of μ μ' ω1 ω1' " MBV a ∪ V" ω ω']
      have sub2:"FVP b ⊆ MBV a ∪ V" using sub by auto
      obtain ω2 ω2' where sem2:"((ω1, ω1'), (ω2, ω2')) ∈ prog_sem J b" and VA2:"Vagree (ω, ω') (ω2, ω2') (MBV b ∪ (MBV a ∪ V))"
        using IH2[OF IA(2) VA1 sub2 sem(2)] by auto
      show "∃ab bb. ((ν2, ν2'), (ab, bb)) ∈ prog_sem J a O prog_sem J b ∧ Vagree (ω, ω') (ab, bb) (MBV a ∪ MBV b ∪ V)"
        using sem1 sem2 VA1 VA2
        by (metis (no_types, lifting) Un_assoc Un_left_commute relcomp.relcompI)
    qed
  done
next
  case (hpsafe_Loop a) then show "?case" 
    apply(unfold coincide_hp'_def coincide_hp_def)
    apply(rule allI)+
    apply(rule conjI)
     prefer 2 subgoal unfolding ode_sem_equiv_def by auto
    apply(rule allI | rule impI)+
    apply(unfold prog_sem.simps FVP.simps MBV.simps SIGP.simps)
    subgoal for I J ν ν' μ V
    proof -
      assume safe:"hpsafe a"
      assume IH:"(∀ I J. (∀ν ν' μ V.
       Iagree I J (SIGP a) ⟶
       Vagree ν ν' V ⟶ FVP a ⊆ V ⟶ (ν, μ) ∈ prog_sem I a ⟶ (∃μ'. (ν', μ') ∈ prog_sem J a ∧ Vagree μ μ' (MBV a ∪ V)))
       ∧  ode_sem_equiv a I)"
      assume agree:"Iagree I J (SIGP a)"
      assume VA:"Vagree ν ν' V"
      assume sub:"FVP a ⊆ V"
      have "(ν, μ) ∈ (prog_sem I a)⇧^* ⟹ (⋀ν'. Vagree ν ν' V ⟹ ∃μ'. (ν', μ') ∈ (prog_sem J a)⇧^* ∧ Vagree μ μ' ({} ∪ V))"
        apply(induction rule: converse_rtrancl_induct)
         apply(auto)
        subgoal for ω ω' s s' v v'
        proof -
          assume sem1:"((ω, ω'), (s, s')) ∈ prog_sem I a"
            and sem2:"((s, s'), μ) ∈ (prog_sem I a)⇧^*"
            and IH2:"⋀v v'. (Vagree (s, s') (v,v') V ⟹ ∃ab ba. ((v,v'), (ab, ba)) ∈ (prog_sem J a)⇧^* ∧ Vagree μ (ab, ba) V)"
            and VA:"Vagree (ω, ω') (v,v') V"
          obtain s'' where sem'':"((v, v'), s'') ∈ prog_sem J a" and VA'':"Vagree (s,s') s'' (MBV a ∪ V)"
            using IH agree VA sub sem1 agree_refl by blast
          then obtain s'1 and s'2 where sem'':"((v, v'), (s'1, s'2)) ∈ prog_sem J a" and VA'':"Vagree (s,s') (s'1, s'2) (MBV a ∪ V)"
            using IH agree VA sub sem1 agree_refl by (cases "s''", blast)
          from VA'' have VA''V:"Vagree (s,s') (s'1, s'2) V" 
            using agree_sub by blast
          note IH2' = IH2[of s'1 s'2]
          note IH2'' = IH2'[OF VA''V]
          then obtain ab and ba where  sem''':"((s'1, s'2), (ab, ba)) ∈ (prog_sem J a)⇧^*" and VA''':"Vagree μ (ab, ba) V"
              using  IH2'' by auto
          from sem'' sem''' have sem:"((v, v'), (ab, ba)) ∈ (prog_sem J a)⇧^*" by auto
          show "∃μ'1 μ'2. ((v, v'), (μ'1, μ'2)) ∈ (prog_sem J a)⇧^* ∧ Vagree μ (μ'1, μ'2) V"
            using sem VA''' by blast
          qed
        done
      then show "(ν, μ) ∈ (prog_sem I a)⇧^* ⟹  Vagree ν ν' V ⟹ ∃μ'. (ν', μ') ∈ (prog_sem J a)⇧^* ∧ Vagree μ μ' ({} ∪ V)"
        by auto
    qed
  done
next
  case (fsafe_Geq t1 t2) 
  then have safe:"dsafe t1" "dsafe t2" by auto
  have almost:"⋀ν ν'. ⋀ I J :: ('a, 'b, 'c) interp. Iagree I J (SIGF (Geq t1 t2)) ⟹ Vagree ν ν' (FVF (Geq t1 t2)) ⟹ (ν ∈ fml_sem I (Geq t1 t2)) = (ν' ∈ fml_sem J (Geq t1 t2))" 
  proof -
    fix ν ν'  and I J :: "('a, 'b, 'c) interp"
    assume IA:"Iagree I J (SIGF (Geq t1 t2))"
    hence IAs:"Iagree I J {Inl x | x. x ∈ (SIGT t1)}"
              "Iagree I J {Inl x | x. x ∈ (SIGT t2)}" 
      unfolding SIGF.simps Iagree_def by auto
    assume VA:"Vagree ν ν' (FVF (Geq t1 t2))"
    hence VAs:"Vagree ν ν' (FVT t1)" "Vagree ν ν' (FVT t2)"
      unfolding FVF.simps Vagree_def by auto
    have sem1:"dterm_sem I t1 ν = dterm_sem J t1 ν'"
      by (auto simp add: coincidence_dterm'[OF safe(1) VAs(1) IAs(1)])
    have sem2:"dterm_sem I t2 ν = dterm_sem J t2 ν'"
      by (auto simp add: coincidence_dterm'[OF safe(2) VAs(2) IAs(2)])
    show "(ν ∈ fml_sem I (Geq t1 t2)) = (ν' ∈ fml_sem J (Geq t1 t2))"
      by (simp add: sem1 sem2)
  qed
  show "?case" using almost unfolding coincide_fml_def by blast
next
  case (fsafe_Prop args p)
    then have safes:"⋀arg. arg ∈ range args ⟹ dsafe arg" using dfree_is_dsafe by auto
    have almost:"⋀ν ν'. ⋀ I J::('a, 'b, 'c) interp. Iagree I J (SIGF (Prop p args)) ⟹ Vagree ν ν' (FVF (Prop p args)) ⟹ (ν ∈ fml_sem I (Prop p args)) = (ν' ∈ fml_sem J (Prop p args))" 
    proof -
      fix ν ν' and I J :: "('a, 'b, 'c) interp"
      assume IA:"Iagree I J (SIGF (Prop p args))"
      have subs:"⋀i. {Inl x | x. x ∈ SIGT (args i)} ⊆ (SIGF (Prop p args))"
        by auto
      have IAs:"⋀i. Iagree I J {Inl x | x. x ∈ SIGT (args i)}"
        using IA apply(unfold SIGF.simps)
        subgoal for i
          using Iagree_sub[OF subs[of i]] by auto
        done
      have mem:"Inr (Inr p) ∈ {Inr (Inr p)} ∪ {Inl x |x. x ∈ (⋃i. SIGT (args i))}"
        by auto
      from IA have pSame:"Predicates I p = Predicates J p"
        by (auto simp add: Iagree_Pred IA mem)
      assume VA:"Vagree ν ν' (FVF (Prop p args))"
      hence VAs:"⋀i. Vagree ν ν' (FVT (args i))"
        unfolding FVF.simps Vagree_def by auto
      have sems:"⋀i. dterm_sem I (args i) ν = dterm_sem J (args i) ν'"
        using IAs VAs coincidence_dterm' rangeI safes 
        by (simp add: coincidence_dterm')
      hence vecSem:"(χ i. dterm_sem I (args i) ν) = (χ i. dterm_sem J (args i) ν')"
        by auto
      show "(ν ∈ fml_sem I (Prop p args)) = (ν' ∈ fml_sem J (Prop p args))"
        apply(unfold fml_sem.simps mem_Collect_eq)
        using IA vecSem pSame by (auto)
    qed
  then show "?case" unfolding coincide_fml_def by blast
next
  case fsafe_Not then show "?case" by auto
next
  case (fsafe_And p1 p2)
  then have safes:"fsafe p1" "fsafe p2" 
    and IH1:"∀ ν ν' I J. Iagree I J (SIGF p1) ⟶ Vagree ν ν' (FVF p1) ⟶ (ν ∈ fml_sem I p1) = (ν' ∈ fml_sem J p1)"
    and IH2:"∀ ν ν' I J. Iagree I J (SIGF p2) ⟶ Vagree ν ν' (FVF p2) ⟶ (ν ∈ fml_sem I p2) = (ν' ∈ fml_sem J p2)"
      by auto
  have almost:"⋀ν ν' I J. Iagree I J (SIGF (And p1 p2)) ⟹ Vagree ν ν' (FVF (And p1 p2)) ⟹ (ν ∈ fml_sem I (And p1 p2)) = (ν' ∈ fml_sem J (And p1 p2))" 
  proof -
    fix ν ν' I J
    assume IA:"Iagree I J (SIGF (And p1 p2))"
    have IAsubs:"(SIGF p1) ⊆ (SIGF (And p1 p2))" "(SIGF p2) ⊆ (SIGF (And p1 p2))" by auto
    from IA have IAs:"Iagree I J (SIGF p1)" "Iagree I J (SIGF p2)"
      using Iagree_sub[OF IAsubs(1)] Iagree_sub[OF IAsubs(2)] by auto
    assume VA:"Vagree ν ν' (FVF (And p1 p2))"
    hence VAs:"Vagree ν ν' (FVF p1)" "Vagree ν ν' (FVF p2)"
      unfolding FVF.simps Vagree_def by auto
    have eq1:"(ν ∈ fml_sem I p1) = (ν' ∈ fml_sem J p1)" using IH1 IAs VAs by blast
    have eq2:"(ν ∈ fml_sem I p2) = (ν' ∈ fml_sem J p2)" using IH2 IAs VAs by blast
    show "(ν ∈ fml_sem I (And p1 p2)) = (ν' ∈ fml_sem J (And p1 p2))"
      using eq1 eq2 by auto
  qed
  then show "?case" unfolding coincide_fml_def by blast
next
  case (fsafe_Exists p x)
  then have safe:"fsafe p"
    and IH:"∀ ν ν' I J. Iagree I J (SIGF p) ⟶ Vagree ν ν' (FVF p) ⟶ (ν ∈ fml_sem I p) = (ν' ∈ fml_sem J p)"
    by auto
  have almost:"⋀ν ν' I J. Iagree I J (SIGF (Exists x p)) ⟹ Vagree ν ν' (FVF (Exists x p)) ⟹ (ν ∈ fml_sem I (Exists x p)) = (ν' ∈ fml_sem J (Exists x p))" 
  proof -
    fix ν ν' I J
    assume IA:"Iagree I J (SIGF (Exists x p))"
    hence IA':"Iagree I J (SIGF p)" 
      unfolding SIGF.simps Iagree_def by auto
    assume VA:"Vagree ν ν' (FVF (Exists x p))"
    hence VA':"Vagree ν ν' (FVF p - {Inl x})" by auto
    hence VA'':"⋀r. Vagree (repv ν x r) (repv ν' x r) (FVF p)" 
      subgoal for r 
        unfolding Vagree_def FVF.simps repv.simps
        by auto
      done
    have IH': "⋀r. Iagree I J (SIGF p) ⟹ Vagree (repv ν x r) (repv ν' x r) (FVF p) ⟹ ((repv ν x r) ∈ fml_sem I p) = ((repv ν' x r) ∈ fml_sem J p)"
      subgoal for r
        using IH apply(rule allE[where x = "repv ν x r"])
        apply(erule allE[where x = "repv ν' x r"])
        by (auto)
      done
    hence IH'':"⋀r. ((repv ν x r) ∈ fml_sem I p) = ((repv ν' x r) ∈ fml_sem J p)"
      subgoal for r
        using IA' VA'' by auto
      done
    have fact:"⋀r. (repv ν x r ∈ fml_sem I p) = (repv ν' x r ∈ fml_sem J p)"
      subgoal for r
        using IH'[OF IA' VA''] by auto
      done
    show "(ν ∈ fml_sem I (Exists x p)) = (ν' ∈ fml_sem J (Exists x p))"
      apply(simp only: fml_sem.simps mem_Collect_eq)
      using IH'' by auto
  qed
  then show "?case" unfolding coincide_fml_def by blast
next
  case (fsafe_Diamond a p) then 
  have hsafe:"hpsafe a"
    and psafe:"fsafe p"
    and IH1:"∀ I J. (∀ν ν' μ V. Iagree I J (SIGP a) ⟶
             Vagree ν ν' V ⟶
             FVP a ⊆ V ⟶ (ν, μ) ∈ prog_sem I a ⟶ (∃μ'. (ν', μ') ∈ prog_sem J a ∧ Vagree μ μ' (MBV a ∪ V)))"
    and IH2:"∀ν ν' I J. Iagree I J (SIGF p) ⟶ Vagree ν ν' (FVF p) ⟶ (ν ∈ fml_sem I p) = (ν' ∈ fml_sem J p)"
      unfolding coincide_hp'_def coincide_hp_def coincide_fml_def apply auto done
  have almost:"⋀ν ν' I J. Iagree I J (SIGF (Diamond a p)) ⟹ Vagree ν ν' (FVF (Diamond a p)) ⟹ (ν ∈ fml_sem I (Diamond a p)) = (ν' ∈ fml_sem J (Diamond a p))" 
  proof -
    fix ν ν' I J
    assume IA:"Iagree I J (SIGF (Diamond a p))"
    have IAsubs:"(SIGP a) ⊆ (SIGF (Diamond a p))" "(SIGF p) ⊆ (SIGF (Diamond a p))" by auto
    from IA have IAP:"Iagree I J (SIGP a)"
      and IAF:"Iagree I J (SIGF p)" using Iagree_sub[OF IAsubs(1)] Iagree_sub[OF IAsubs(2)] by auto
    from IAP have IAP':"Iagree J I (SIGP a)" by (rule Iagree_comm)
    from IAF have IAF':"Iagree J I (SIGF p)" by (rule Iagree_comm)
    assume VA:"Vagree ν ν' (FVF (Diamond a p))"
    hence VA':"Vagree ν' ν (FVF (Diamond a p))" by (rule agree_comm)
    have dir1:"ν ∈ fml_sem I (Diamond a p) ⟹ ν' ∈ fml_sem J (Diamond a p)"
    proof - 
      assume sem:"ν ∈ fml_sem I (Diamond a p)"
      let ?V = "FVF (Diamond a p)"
      have Vsup:"FVP a ⊆ ?V" by auto
      obtain μ where prog:"(ν, μ) ∈ prog_sem I a" and fml:"μ ∈ fml_sem I p" 
        using sem by auto
      from IH1 have IH1':
        "Iagree I J (SIGP a) ⟹
           Vagree ν ν' ?V ⟹
           FVP a ⊆ ?V ⟹ (ν, μ) ∈ prog_sem I a ⟹ (∃μ'. (ν', μ') ∈ prog_sem J a ∧ Vagree μ μ' (MBV a ∪ ?V))"
        by blast
      obtain μ' where prog':"(ν', μ') ∈ prog_sem J a" and agree:"Vagree μ μ' (MBV a ∪ ?V)"
        using IH1'[OF IAP VA Vsup prog] by blast
      from IH2 
      have IH2':"Iagree I J (SIGF p) ⟹ Vagree μ μ' (FVF p) ⟹ (μ ∈ fml_sem I p) = (μ' ∈ fml_sem J p)"
        by blast
      have  VAF:"Vagree μ μ' (FVF p)"
        using agree VA by (auto simp only: Vagree_def FVF.simps)
      hence IH2'':"(μ ∈ fml_sem I p) = (μ' ∈ fml_sem J p)"
        using IH2'[OF IAF VAF] by auto
      have fml':"μ' ∈ fml_sem J p" using IH2'' fml by auto
      have "∃ μ'. (ν', μ') ∈ prog_sem J a ∧ μ' ∈ fml_sem J p" using fml' prog' by blast
      then show "ν' ∈ fml_sem J (Diamond a p)" 
        unfolding fml_sem.simps by (auto simp only: mem_Collect_eq)
    qed
    have dir2:"ν' ∈ fml_sem J (Diamond a p) ⟹ ν ∈ fml_sem I (Diamond a p)"
    proof - 
      assume sem:"ν' ∈ fml_sem J (Diamond a p)"
      let ?V = "FVF (Diamond a p)"
      have Vsup:"FVP a ⊆ ?V" by auto
      obtain μ where prog:"(ν', μ) ∈ prog_sem J a" and fml:"μ ∈ fml_sem J p" 
        using sem by auto
      from IH1 have IH1':
        "Iagree J I (SIGP a) ⟹
           Vagree ν' ν ?V ⟹
           FVP a ⊆ ?V ⟹ (ν', μ) ∈ prog_sem J a ⟹ (∃μ'. (ν, μ') ∈ prog_sem I a ∧ Vagree μ μ' (MBV a ∪ ?V))"
        by blast
      obtain μ' where prog':"(ν, μ') ∈ prog_sem I a" and agree:"Vagree μ μ' (MBV a ∪ ?V)"
        using IH1'[OF IAP' VA' Vsup prog] by blast
      from IH2 
      have IH2':"Iagree J I (SIGF p) ⟹ Vagree μ μ' (FVF p) ⟹ (μ ∈ fml_sem J p) = (μ' ∈ fml_sem I p)"
        by blast
      have  VAF:"Vagree μ μ' (FVF p)"
        using agree VA by (auto simp only: Vagree_def FVF.simps)
      hence IH2'':"(μ ∈ fml_sem J p) = (μ' ∈ fml_sem I p)"
        using IH2'[OF IAF' VAF] by auto
      have fml':"μ' ∈ fml_sem I p" using IH2'' fml by auto
      have "∃ μ'. (ν, μ') ∈ prog_sem I a ∧ μ' ∈ fml_sem I p" using fml' prog' by blast
      then show "ν ∈ fml_sem I (Diamond a p)" 
        unfolding fml_sem.simps by (auto simp only: mem_Collect_eq)
    qed
    show "(ν ∈ fml_sem I (Diamond a p)) = (ν' ∈ fml_sem J (Diamond a p))"
      using dir1 dir2 by auto
  qed
  then show "?case" unfolding coincide_fml_def by blast
next
  case (fsafe_InContext φ) then 
  have safe:"fsafe φ"
    and IH:"(∀ ν ν' I J. Iagree I J (SIGF φ) ⟶ Vagree ν ν' (FVF φ) ⟶ ν ∈ fml_sem I φ ⟷ ν' ∈ fml_sem J φ)"
    by (unfold coincide_fml_def)
  hence IH':"⋀ν ν' I J. Iagree I J (SIGF φ) ⟹ Vagree ν ν' (FVF φ) ⟹ ν ∈ fml_sem I φ ⟷ ν' ∈ fml_sem J φ"
    by auto
  hence sem_eq:"⋀I J. Iagree I J (SIGF φ) ⟹ fml_sem I φ = fml_sem J φ"
    apply (auto simp: Collect_cong Collect_mem_eq agree_refl)
     using agree_refl by blast+
  have "(⋀ ν ν' I J C . Iagree I J (SIGF (InContext C φ)) ⟹ Vagree ν ν' (FVF (InContext C φ)) ⟹ ν ∈ fml_sem I (InContext C φ)  ⟷ ν' ∈ fml_sem J (InContext C φ))"
    proof -
      fix ν ν' I J C
      assume IA:"Iagree I J (SIGF (InContext C φ))"
      then have IA':"Iagree I J (SIGF φ)" unfolding SIGF.simps Iagree_def by auto
      assume VA:"Vagree ν ν' (FVF (InContext C φ))"
      then have VAU:"Vagree ν ν' UNIV" unfolding FVF.simps Vagree_def by auto
      then have VA':"Vagree ν ν' (FVF φ)" unfolding FVF.simps Vagree_def by auto
      from VAU have eq:"ν = ν'" by (cases "ν", cases "ν'", auto simp add: vec_eq_iff Vagree_def)
      from IA have Cmem:"Inr (Inl C) ∈ SIGF (InContext C φ)"
        by simp
      have Cagree:"Contexts I C = Contexts J C" by (rule Iagree_Contexts[OF IA Cmem])
      show "ν ∈ fml_sem I (InContext C φ)  ⟷ ν' ∈ fml_sem J (InContext C φ)"  
        using Cagree eq sem_eq IA' by (auto)
    qed
  then show "?case" by simp
qed 

lemma coincidence_formula:"⋀ν ν' I J. fsafe (φ::('a::finite, 'b::finite, 'c::finite) formula) ⟹ Iagree I J (SIGF φ) ⟹ Vagree ν ν' (FVF φ) ⟹ (ν ∈ fml_sem I φ ⟷ ν' ∈ fml_sem J φ)"
  using coincidence_hp_fml unfolding coincide_fml_def by blast 

lemma coincidence_hp:
  fixes ν ν' μ V I J
  assumes safe:"hpsafe (α::('a::finite, 'b::finite, 'c::finite) hp)"
  assumes IA:"Iagree I J (SIGP α)"
  assumes VA:"Vagree ν ν' V"
  assumes sub:"V ⊇ (FVP α)"
  assumes sem:"(ν, μ) ∈ prog_sem I α"   
  shows "(∃μ'. (ν', μ') ∈ prog_sem J α ∧ Vagree μ μ' (MBV α ∪ V))"
proof -
  have thing:"(∀I J. (∀ν ν' μ V.
            Iagree I J (SIGP α) ⟶
            Vagree ν ν' V ⟶ FVP α ⊆ V ⟶ (ν, μ) ∈ prog_sem I α ⟶ (∃μ'. (ν', μ') ∈ prog_sem J α ∧ Vagree μ μ' (MBV α ∪ V))) ∧
        ode_sem_equiv α I)" 
    using coincidence_hp_fml unfolding coincide_hp_def coincide_hp'_def
    using safe by blast
  then have "(Iagree I J (SIGP α) ⟹
            Vagree ν ν' V ⟹ FVP α ⊆ V ⟹ (ν, μ) ∈ prog_sem I α ⟹ (∃μ'. (ν', μ') ∈ prog_sem J α ∧ Vagree μ μ' (MBV α ∪ V)))"
    using IA VA sub sem thing by blast
  then show "(∃μ'. (ν', μ') ∈ prog_sem J α ∧ Vagree μ μ' (MBV α ∪ V))"
    using IA VA sub sem by auto
qed

subsection ‹Corollaries: Alternate ODE semantics definition›

lemma ode_sem_eq:
  fixes I::"('a::finite,'b::finite,'c::finite) interp" and ODE::"('a,'c) ODE" and φ::"('a,'b,'c) formula"
  assumes osafe:"osafe ODE"
  assumes fsafe:"fsafe φ"
  shows
 "({(ν, mk_v I ODE ν (sol t)) | ν sol t.
      t ≥ 0 ∧
      (sol solves_ode (λ_. ODE_sem I ODE)) {0..t} {x. mk_v I ODE ν x ∈ fml_sem I φ} ∧
      VSagree (sol 0) (fst ν) {x | x. Inl x ∈ FVP (EvolveODE ODE φ)}}) = 
  ({(ν, mk_v I ODE ν (sol t)) | ν sol t.
      t ≥ 0 ∧
      (sol solves_ode (λ_. ODE_sem I ODE)) {0..t} {x. mk_v I ODE ν x ∈ fml_sem I φ} ∧
      (sol 0) = (fst ν)})"
proof - 
  have hpsafe:"hpsafe (EvolveODE ODE φ)" using osafe fsafe by (auto intro: hpsafe_fsafe.intros)
  have "coincide_hp'(EvolveODE ODE φ)" using coincidence_hp_fml hpsafe by blast
  hence "ode_sem_equiv (EvolveODE ODE φ) I" unfolding coincide_hp'_def by auto
  then show "?thesis" 
    unfolding ode_sem_equiv_def using osafe fsafe by auto
qed

lemma ode_alt_sem:"⋀I::('a::finite,'b::finite,'c::finite) interp. ⋀ODE::('a,'c) ODE. ⋀φ::('a,'b,'c)formula. osafe ODE ⟹ fsafe φ  ⟹ 
  prog_sem I (EvolveODE ODE φ)
= 
{(ν, mk_v I ODE ν (sol t)) | ν sol t.
      t ≥ 0 ∧
      (sol solves_ode (λ_. ODE_sem I ODE)) {0..t} {x. mk_v I ODE ν x ∈ fml_sem I φ} ∧
      VSagree (sol 0) (fst ν) {x | x. Inl x ∈ FVP (EvolveODE ODE φ)}}
" 
  subgoal for I ODE φ
    using ode_sem_eq[of ODE φ I] by auto
  done
end
end

Theory Differential_Axioms

theory "Differential_Axioms" 
imports
  Ordinary_Differential_Equations.ODE_Analysis
  "Ids"
  "Lib"
  "Syntax"     
  "Denotational_Semantics"
  "Frechet_Correctness"
  "Axioms"
  "Coincidence"
begin context ids begin
section ‹Differential Axioms›
text ‹Differential axioms fall into two categories:
Axioms for computing the derivatives of terms and axioms for proving properties of ODEs.
The derivative axioms are all corollaries of the frechet correctness theorem. The ODE
axioms are more involved, often requiring extensive use of the ODE libraries.› 

subsection ‹Derivative Axioms›
definition diff_const_axiom :: "('sf, 'sc, 'sz) formula"
where [axiom_defs]:"diff_const_axiom ≡ Equals (Differential ($f fid1 empty)) (Const 0)"

definition diff_var_axiom :: "('sf, 'sc, 'sz) formula"
where [axiom_defs]:"diff_var_axiom ≡ Equals (Differential (Var vid1)) (DiffVar vid1)"
  
definition state_fun ::"'sf ⇒ ('sf, 'sz) trm"
where [axiom_defs]:"state_fun f = ($f f (λi. Var i))"
  
definition diff_plus_axiom :: "('sf, 'sc, 'sz) formula"
where [axiom_defs]:"diff_plus_axiom ≡ Equals (Differential (Plus (state_fun fid1) (state_fun fid2))) 
    (Plus (Differential (state_fun fid1)) (Differential (state_fun fid2)))"

definition diff_times_axiom :: "('sf, 'sc, 'sz) formula"
where [axiom_defs]:"diff_times_axiom ≡ Equals (Differential (Times (state_fun fid1) (state_fun fid2))) 
    (Plus (Times (Differential (state_fun fid1)) (state_fun fid2)) 
          (Times (state_fun fid1) (Differential (state_fun fid2))))"

― ‹‹[y=g(x)][y'=1](f(g(x))' = f(y)')››
definition diff_chain_axiom::"('sf, 'sc, 'sz) formula"
where [axiom_defs]:"diff_chain_axiom ≡ [[Assign vid2 (f1 fid2 vid1)]]([[DiffAssign vid2 (Const 1)]] 
  (Equals (Differential ($f fid1 (singleton (f1 fid2 vid1)))) (Times (Differential (f1 fid1 vid2)) (Differential (f1 fid2 vid1)))))"

subsection ‹ODE Axioms›
definition DWaxiom :: "('sf, 'sc, 'sz) formula"
where [axiom_defs]:"DWaxiom = ([[EvolveODE (OVar vid1) (Predicational pid1)]](Predicational pid1))"

definition DWaxiom' :: "('sf, 'sc, 'sz) formula"
where [axiom_defs]:"DWaxiom' = ([[EvolveODE (OSing vid1 (Function fid1 (singleton (Var vid1)))) (Prop vid2 (singleton (Var vid1)))]](Prop vid2 (singleton (Var vid1))))"
  
definition DCaxiom :: "('sf, 'sc, 'sz) formula"
where [axiom_defs]:"DCaxiom = (
([[EvolveODE (OVar vid1) (Predicational pid1)]]Predicational pid3) →
(([[EvolveODE (OVar vid1) (Predicational pid1)]](Predicational pid2)) 
  ↔  
   ([[EvolveODE (OVar vid1) (And (Predicational pid1) (Predicational pid3))]]Predicational pid2)))"

definition DEaxiom :: "('sf, 'sc, 'sz) formula"
where [axiom_defs]:"DEaxiom = 
(([[EvolveODE (OSing vid1 (f1 fid1 vid1)) (p1 vid2 vid1)]] (P pid1))
↔
 ([[EvolveODE (OSing vid1 (f1 fid1 vid1)) (p1 vid2 vid1)]]
    [[DiffAssign vid1 (f1 fid1 vid1)]]P pid1))"
  
definition DSaxiom :: "('sf, 'sc, 'sz) formula"
where [axiom_defs]:"DSaxiom = 
(([[EvolveODE (OSing vid1 (f0 fid1)) (p1 vid2 vid1)]]p1 vid3 vid1)
↔ 
(Forall vid2 
 (Implies (Geq (Var vid2) (Const 0)) 
 (Implies 
   (Forall vid3 
     (Implies (And (Geq (Var vid3) (Const 0)) (Geq (Var vid2) (Var vid3)))
        (Prop vid2 (singleton (Plus (Var vid1) (Times (f0 fid1) (Var vid3)))))))
   ([[Assign vid1 (Plus (Var vid1) (Times (f0 fid1) (Var vid2)))]]p1 vid3 vid1)))))"

― ‹‹(Q → [c&Q](f(x)' ≥ g(x)'))›› 
― ‹‹→››
― ‹‹([c&Q](f(x) ≥ g(x))) --> (Q → (f(x) ≥ g(x))›› 
definition DIGeqaxiom :: "('sf, 'sc, 'sz) formula"
where [axiom_defs]:"DIGeqaxiom = 
Implies 
  (Implies (Prop vid1 empty) ([[EvolveODE (OVar vid1) (Prop vid1 empty)]](Geq (Differential (f1 fid1 vid1)) (Differential (f1 fid2 vid1)))))
  (Implies
     (Implies(Prop vid1 empty) (Geq (f1 fid1 vid1) (f1 fid2 vid1)))
     ([[EvolveODE (OVar vid1) (Prop vid1 empty)]](Geq (f1 fid1 vid1) (f1 fid2 vid1))))"


― ‹‹g(x) > h(x) → [x'=f(x), c & p(x)](g(x)' ≥ h(x)') → [x'=f(x), c & p(x)]g(x) > h(x)›› 

― ‹‹(Q → [c&Q](f(x)' ≥ g(x)'))›› 
― ‹‹→››
― ‹‹([c&Q](f(x) > g(x))) <-> (Q → (f(x) > g(x))››
definition DIGraxiom :: "('sf, 'sc, 'sz) formula"
where [axiom_defs]:"DIGraxiom = 
Implies 
  (Implies (Prop vid1 empty) ([[EvolveODE (OVar vid1) (Prop vid1 empty)]](Geq (Differential (f1 fid1 vid1)) (Differential (f1 fid2 vid1)))))
  (Implies
     (Implies(Prop vid1 empty) (Greater (f1 fid1 vid1) (f1 fid2 vid1)))
     ([[EvolveODE (OVar vid1) (Prop vid1 empty)]](Greater (f1 fid1 vid1) (f1 fid2 vid1))))"

― ‹‹[{1' = 1(1) & 1(1)}]2(1) <->››
― ‹‹∃2. [{1'=1(1), 2' = 2(1)*2 + 3(1) & 1(1)}]2(1)*)››
definition DGaxiom :: "('sf, 'sc, 'sz) formula"
where [axiom_defs]:"DGaxiom = (([[EvolveODE (OSing vid1 (f1 fid1 vid1)) (p1 vid1 vid1)]]p1 vid2 vid1) ↔ 
  (Exists vid2 
    ([[EvolveODE (OProd (OSing vid1 (f1 fid1 vid1)) (OSing vid2 (Plus (Times (f1 fid2 vid1) (Var vid2)) (f1 fid3 vid1)))) (p1 vid1 vid1)]]
       p1 vid2 vid1)))"

subsection ‹Proofs for Derivative Axioms›
lemma constant_deriv_inner:
 assumes interp:"∀x i. (Functions I i has_derivative FunctionFrechet I i x) (at x)"
 shows "FunctionFrechet I id1 (vec_lambda (λi. sterm_sem I (empty i) (fst ν))) (vec_lambda(λi. frechet I (empty i) (fst ν) (snd ν)))= 0"
proof -
  have empty_zero:"(vec_lambda(λi. frechet I (empty i) (fst ν) (snd ν))) = 0"
    using local.empty_def Cart_lambda_cong frechet.simps(5) zero_vec_def
    apply auto
    apply(rule vec_extensionality)
    using local.empty_def Cart_lambda_cong frechet.simps(5) zero_vec_def
    by (simp add: local.empty_def)
  let ?x = "(vec_lambda (λi. sterm_sem I (empty i) (fst ν)))"
  from interp
  have has_deriv:"(Functions I id1 has_derivative FunctionFrechet I id1 ?x) (at ?x)"
    by auto
  then have f_linear:"linear (FunctionFrechet I id1 ?x)"
    using Deriv.has_derivative_linear by auto
  then show ?thesis using empty_zero f_linear linear_0 by (auto)
qed

lemma constant_deriv_zero:"is_interp I ⟹ directional_derivative I ($f id1 empty) ν = 0"
  apply(simp only: is_interp_def directional_derivative_def frechet.simps frechet_correctness)
  apply(rule constant_deriv_inner)
  apply(auto)
done

theorem diff_const_axiom_valid: "valid diff_const_axiom"
  apply(simp only: valid_def diff_const_axiom_def equals_sem)
  apply(rule allI | rule impI)+
  apply(simp only: dterm_sem.simps constant_deriv_zero sterm_sem.simps)
done

theorem diff_var_axiom_valid: "valid diff_var_axiom"
  apply(auto simp add: diff_var_axiom_def valid_def directional_derivative_def)
  by (metis inner_prod_eq)
  
theorem diff_plus_axiom_valid: "valid diff_plus_axiom"
  apply(auto simp add: diff_plus_axiom_def valid_def)
  subgoal for I a b
    using frechet_correctness[of I "(Plus (state_fun fid1) (state_fun fid2))" b] 
    unfolding state_fun_def apply (auto intro: dfree.intros)
    unfolding directional_derivative_def by auto
 done
  
theorem diff_times_axiom_valid: "valid diff_times_axiom"
  apply(auto simp add: diff_times_axiom_def valid_def)
  subgoal for I a b
    using frechet_correctness[of I "(Times (state_fun fid1) (state_fun fid2))" b] 
    unfolding state_fun_def apply (auto intro: dfree.intros)
    unfolding directional_derivative_def by auto
  done
  
subsection ‹Proofs for ODE Axioms›
 
lemma DW_valid:"valid DWaxiom"
  apply(unfold DWaxiom_def valid_def Let_def impl_sem )
  apply(safe)
  apply(auto simp only: fml_sem.simps prog_sem.simps box_sem)
  subgoal for I aa ba ab bb sol t using mk_v_agree[of I "(OVar vid1)" "(ab,bb)" "sol t"]
    Vagree_univ[of "aa" "ba" "sol t" "ODEs I vid1 (sol t)"] solves_ode_domainD
    by (fastforce)
  done

lemma DE_lemma:
  fixes ab bb::"'sz simple_state"
  and sol::"real ⇒ 'sz simple_state"
  and I::"('sf, 'sc, 'sz) interp"
  shows
  "repd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) vid1 (dterm_sem I (f1 fid1 vid1) (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)))
   = mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)"
proof
  have set_eq:" {Inl vid1, Inr vid1} = {Inr vid1, Inl vid1}" by auto
  have agree:"Vagree (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) (mk_xode I (OSing vid1 (f1 fid1 vid1)) (sol t))
      {Inl vid1, Inr vid1}" 
    using mk_v_agree[of I "(OSing vid1 (f1 fid1 vid1))" "(ab, bb)" "(sol t)"] 
    unfolding semBV.simps using set_eq by auto
  have fact:"dterm_sem I (f1 fid1 vid1) (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t))
          = snd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) $ vid1"
    using agree unfolding Vagree_def dterm_sem.simps f1_def mk_xode.simps
  proof -
    assume alls:"(∀i. Inl i ∈ {Inl vid1, Inr vid1} ⟶
        fst (mk_v I (OSing vid1 ($f fid1 (singleton (trm.Var vid1)))) (ab, bb) (sol t)) $ i =
        fst (sol t, ODE_sem I (OSing vid1 ($f fid1 (singleton (trm.Var vid1)))) (sol t)) $ i) ∧
      (∀i. Inr i ∈ {Inl vid1, Inr vid1} ⟶
        snd (mk_v I (OSing vid1 ($f fid1 (singleton (trm.Var vid1)))) (ab, bb) (sol t)) $ i =
        snd (sol t, ODE_sem I (OSing vid1 ($f fid1 (singleton (trm.Var vid1)))) (sol t)) $ i)"
    hence atVid'':"snd (mk_v I (OSing vid1 ($f fid1 (singleton (trm.Var vid1)))) (ab, bb) (sol t)) $ vid1 = sterm_sem I ($f fid1 (singleton (trm.Var vid1))) (sol t)" 
      by auto
    have argsEq:"(χ i. dterm_sem I (singleton (trm.Var vid1) i)
          (mk_v I (OSing vid1 ($f fid1 (singleton (trm.Var vid1)))) (ab, bb) (sol t)))
          = (χ i.  sterm_sem I (singleton (trm.Var vid1) i) (sol t))"
      using alls f1_def by auto
    thus "Functions I fid1 (χ i. dterm_sem I (singleton (trm.Var vid1) i)
          (mk_v I (OSing vid1 ($f fid1 (singleton (trm.Var vid1)))) (ab, bb) (sol t))) 
        = snd (mk_v I (OSing vid1 ($f fid1 (singleton (trm.Var vid1)))) (ab, bb) (sol t)) $ vid1"
      by (simp only: atVid'' ODE_sem.simps sterm_sem.simps dterm_sem.simps)
  qed
  have eqSnd:"(χ y. if vid1 = y then snd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) $ vid1
        else snd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) $ y) = snd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t))"
    by (simp add: vec_extensionality)
  have truth:"repd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) vid1
        (dterm_sem I (f1 fid1 vid1) (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)))
      = mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)"
    using fact by (auto simp only: eqSnd repd.simps fact prod.collapse split: if_split)
  thus "fst (repd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) vid1
          (dterm_sem I (f1 fid1 vid1) (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)))) =
    fst (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t))"

    "snd (repd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) vid1
      (dterm_sem I (f1 fid1 vid1) (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)))) =
    snd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) " 
    by auto
qed

lemma DE_valid:"valid DEaxiom"
proof -
  have dsafe:"dsafe ($f fid1 (singleton (trm.Var vid1)))" unfolding singleton_def by(auto intro: dsafe.intros)
  have osafe:"osafe(OSing vid1 (f1 fid1 vid1))" unfolding f1_def empty_def singleton_def using dsafe osafe.intros dsafe.intros
    by (simp add: osafe_Sing dfree_Const) 
  have fsafe:"fsafe (p1 vid2 vid1)" unfolding p1_def singleton_def using hpsafe_fsafe.intros(10)
    using dsafe dsafe_Fun_simps image_iff
    by (simp add: dfree_Const)
  show "valid DEaxiom"
    apply(auto simp only: DEaxiom_def valid_def Let_def iff_sem impl_sem)
     apply(auto simp only: fml_sem.simps prog_sem.simps mem_Collect_eq box_sem)
   proof -
     fix I::"('sf,'sc,'sz) interp"
       and aa ba ab bb sol 
       and t::real
       and ac bc
     assume "is_interp I"
     assume allw:"∀ω. (∃ν sol t.
                  ((ab, bb), ω) = (ν, mk_v I (OSing vid1 (f1 fid1 vid1)) ν (sol t)) ∧
                  0 ≤ t ∧
                  (sol solves_ode (λ_. ODE_sem I (OSing vid1 (f1 fid1 vid1)))) {0..t}
                   {x. mk_v I (OSing vid1 (f1 fid1 vid1)) ν x ∈ fml_sem I (p1 vid2 vid1)} ∧
                  (sol 0) = (fst ν) ) ⟶
              ω ∈ fml_sem I (P pid1)"
     assume t:"0 ≤ t"
     assume aaba:"(aa, ba) = mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)"
     assume solve:" (sol solves_ode (λ_. ODE_sem I (OSing vid1 (f1 fid1 vid1)))) {0..t}
         {x. mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) x ∈ fml_sem I (p1 vid2 vid1)}"
     assume sol0:" (sol 0) = (fst (ab, bb)) "
     assume rep:"   (ac, bc) =
        repd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) vid1
         (dterm_sem I (f1 fid1 vid1) (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)))"
     have aaba_sem:"(aa,ba) ∈ fml_sem I (P pid1)" using allw t aaba solve sol0 rep by blast
     have truth:"repd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) vid1
          (dterm_sem I (f1 fid1 vid1) (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)))
     = mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)"
       using DE_lemma by auto
     show "
        repd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) vid1
         (dterm_sem I (f1 fid1 vid1) (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)))
        ∈ fml_sem I (P pid1)" using aaba aaba_sem truth by (auto)
   next
     fix I::"('sf,'sc,'sz) interp" and  aa ba ab bb sol and t::real
       assume "is_interp I"
       assume all:"∀ω. (∃ν sol t.
                ((ab, bb), ω) = (ν, mk_v I (OSing vid1 (f1 fid1 vid1)) ν (sol t)) ∧
                0 ≤ t ∧
                (sol solves_ode (λ_. ODE_sem I (OSing vid1 (f1 fid1 vid1)))) {0..t}
                 {x. mk_v I (OSing vid1 (f1 fid1 vid1)) ν x ∈ fml_sem I (p1 vid2 vid1)} ∧
                 (sol 0) = (fst ν) ) ⟶
            (∀ω'. ω' = repd ω vid1 (dterm_sem I (f1 fid1 vid1) ω) ⟶ ω' ∈ fml_sem I (P pid1))"
       hence justW:"(∃ν sol t.
                ((ab, bb), (aa, ba)) = (ν, mk_v I (OSing vid1 (f1 fid1 vid1)) ν (sol t)) ∧
                0 ≤ t ∧
                (sol solves_ode (λ_. ODE_sem I (OSing vid1 (f1 fid1 vid1)))) {0..t}
                 {x. mk_v I (OSing vid1 (f1 fid1 vid1)) ν x ∈ fml_sem I (p1 vid2 vid1)} ∧
                (sol 0) = (fst ν)) ⟶
            (∀ω'. ω' = repd (aa, ba) vid1 (dterm_sem I (f1 fid1 vid1) (aa, ba)) ⟶ ω' ∈ fml_sem I (P pid1))"
         by (rule allE)
       assume t:"0 ≤ t"
       assume aaba:"(aa, ba) = mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)"
       assume sol:"(sol solves_ode (λ_. ODE_sem I (OSing vid1 (f1 fid1 vid1)))) {0..t}
        {x. mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) x ∈ fml_sem I (p1 vid2 vid1)}"
       assume sol0:" (sol 0) = (fst (ab, bb))"
       have "repd (aa, ba) vid1 (dterm_sem I (f1 fid1 vid1) (aa, ba)) ∈ fml_sem I (P pid1)"
         using justW t aaba sol sol0 by auto
       hence foo:"repd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) vid1 (dterm_sem I (f1 fid1 vid1) (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t))) ∈ fml_sem I (P pid1)"
         using aaba by auto
       hence "repd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) vid1 (dterm_sem I (f1 fid1 vid1) (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)))
             = mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)" using DE_lemma by auto
       thus "mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t) ∈ fml_sem I (P pid1)" using foo by auto
  qed
qed

lemma ODE_zero:"⋀i. Inl i ∉ BVO ODE ⟹ Inr i ∉ BVO ODE ⟹ ODE_sem I ODE ν $ i= 0"
  by(induction ODE, auto)

lemma DE_sys_valid:
  assumes disj:"{Inl vid1, Inr vid1} ∩ BVO ODE = {}"
  shows "valid (([[EvolveODE (OProd  (OSing vid1 (f1 fid1 vid1)) ODE) (p1 vid2 vid1)]] (P pid1)) ↔
 ([[EvolveODE ((OProd  (OSing vid1 (f1 fid1 vid1))ODE)) (p1 vid2 vid1)]]
    [[DiffAssign vid1 (f1 fid1 vid1)]]P pid1))"
proof -
  have dsafe:"dsafe ($f fid1 (singleton (trm.Var vid1)))" unfolding singleton_def by(auto intro: dsafe.intros)
  have osafe:"osafe(OSing vid1 (f1 fid1 vid1))" unfolding f1_def empty_def singleton_def using dsafe osafe.intros dsafe.intros
    by (simp add: osafe_Sing dfree_Const) 
  have fsafe:"fsafe (p1 vid2 vid1)" unfolding p1_def singleton_def using hpsafe_fsafe.intros(10)
    using dsafe dsafe_Fun_simps image_iff
    by (simp add: dfree_Const)
  show "valid (([[EvolveODE (OProd (OSing vid1 (f1 fid1 vid1)) ODE) (p1 vid2 vid1)]] (P pid1)) ↔
 ([[EvolveODE ((OProd (OSing vid1 (f1 fid1 vid1)) ODE)) (p1 vid2 vid1)]]
    [[DiffAssign vid1 (f1 fid1 vid1)]]P pid1))"
    apply(auto simp only: DEaxiom_def valid_def Let_def iff_sem impl_sem)
    apply(auto simp only: fml_sem.simps prog_sem.simps mem_Collect_eq box_sem f1_def p1_def P_def expand_singleton)
   proof -
     fix I ::"('sf,'sc,'sz) interp"
       and aa ba ab bb sol 
       and t::real
       and ac bc
     assume good:"is_interp I"
     assume bigAll:"
     ∀ω. (∃ν sol t. ((ab, bb), ω) = (ν, mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) ODE) ν (sol t)) ∧
                    0 ≤ t ∧
                    (sol solves_ode (λ_. ODE_sem I (OProd(OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) ODE ))) {0..t}
                     {x. Predicates I vid2
                          (χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                                 (mk_v I (OProd  (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) ν x))} ∧
                    sol 0 = fst ν) ⟶
          ω ∈ fml_sem I (Pc pid1)"
     let ?myω = "mk_v I (OProd  (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab,bb) (sol t)"
     assume t:"0 ≤ t"
     assume aaba:"(aa, ba) = mk_v I (OProd  (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t)"
     assume sol:"(sol solves_ode (λ_. ODE_sem I (OProd  (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE))) {0..t}
      {x. Predicates I vid2
           (χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                  (mk_v I (OProd  (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) x))}"
     assume sol0:"sol 0 = fst (ab, bb)"
     assume acbc:"(ac, bc) =
     repd (mk_v I (OProd  (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t)) vid1
      (dterm_sem I ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))
        (mk_v I (OProd  (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t)))"
     have bigEx:"(∃ν sol t. ((ab, bb), ?myω) = (ν, mk_v I (OProd  (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) ν (sol t)) ∧
                    0 ≤ t ∧
                    (sol solves_ode (λ_. ODE_sem I (OProd  (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE))) {0..t}
                     {x. Predicates I vid2
                          (χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                                 (mk_v I (OProd  (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) ν x))} ∧
                    sol 0 = fst ν)"
       apply(rule exI[where x="(ab, bb)"])
       apply(rule exI[where x="sol"])
       apply(rule exI[where x="t"])
       apply(rule conjI) 
        apply(rule refl)
       apply(rule conjI)
        apply(rule t)
       apply(rule conjI)
        using sol apply blast
       by (rule sol0)
     have bigRes:"?myω ∈ fml_sem I (Pc pid1)" using bigAll bigEx by blast
     have notin1:"Inl vid1 ∉ BVO ODE" using disj by auto
     have notin2:"Inr vid1 ∉ BVO ODE" using disj by auto
     have ODE_sem:"ODE_sem I ODE (sol t) $ vid1 = 0"
       using ODE_zero notin1 notin2 
       by blast 
     have vec_eq:"(χ i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (sol t)) =
           (χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
            (mk_v I (OProd  (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t)))"
       apply(rule vec_extensionality)
       apply simp
       using mk_v_agree[of I "(OProd  (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE)" "(ab, bb)" "(sol t)"]
       by(simp add: Vagree_def)
     have sem_eq:"(?myω ∈ fml_sem I (Pc pid1)) = ((repd (mk_v I (OProd  (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t)) vid1
     (dterm_sem I ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))
       (mk_v I (OProd  (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t)))) ∈ fml_sem I (Pc pid1))"
       apply(rule coincidence_formula)
         subgoal by simp
        subgoal by (rule Iagree_refl)
       using mk_v_agree[of "I" "(OProd  (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE)" "(ab, bb)" "(sol t)"]
       unfolding Vagree_def 
       apply simp
       apply(erule conjE)+
       apply(erule allE[where x="vid1"])+
       apply(simp add: ODE_sem)
       using vec_eq by simp
     show  "repd (mk_v I (OProd  (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t)) vid1
      (dterm_sem I ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))
        (mk_v I (OProd  (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t)))
     ∈ fml_sem I (Pc pid1)"
       using bigRes sem_eq by blast
   next
     fix I::"('sf,'sc,'sz)interp" 
     and aa ba ab bb sol 
     and t::real
     assume good_interp:"is_interp I"
     assume all:"∀ω. (∃ν sol t. ((ab, bb), ω) = (ν, mk_v I (OProd  (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) ν (sol t)) ∧
                       0 ≤ t ∧
                       (sol solves_ode (λ_. ODE_sem I (OProd  (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE))) {0..t}
                        {x. Predicates I vid2
                             (χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                                    (mk_v I (OProd  (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) ν x))} ∧
                       sol 0 = fst ν) ⟶
             (∀ω'. ω' = repd ω vid1 (dterm_sem I ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)) ω) ⟶ ω' ∈ fml_sem I (Pc pid1))"
      let ?myω = "mk_v I (OProd  (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t)" 
      assume t:"0 ≤ t"
      assume aaba:"(aa, ba) = mk_v I (OProd  (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t)"
      assume sol:"
        (sol solves_ode (λ_. ODE_sem I (OProd  (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE))) {0..t}
         {x. Predicates I vid2
              (χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                    (mk_v I (OProd  (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) x))}"
      assume sol0:"sol 0 = fst (ab, bb)"
      have bigEx:"(∃ν sol t. ((ab, bb), ?myω) = (ν, mk_v I (OProd  (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) ν (sol t)) ∧
                      0 ≤ t ∧
                      (sol solves_ode (λ_. ODE_sem I (OProd  (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE))) {0..t}
                       {x. Predicates I vid2
                            (χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                                   (mk_v I (OProd  (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) ν x))} ∧
                      sol 0 = fst ν)"
        apply(rule exI[where x="(ab, bb)"])
        apply(rule exI[where x=sol])
        apply(rule exI[where x=t])
        apply(rule conjI)
         apply(rule refl)
        apply(rule conjI)
         apply(rule t)
        apply(rule conjI)
         using sol sol0 by(blast)+
      have rep_sem_eq:"repd (mk_v I (OProd  (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t)) vid1
                 (dterm_sem I ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))
                   (mk_v I (OProd  (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t)))  ∈ fml_sem I (Pc pid1)
         = (repd ?myω vid1 (dterm_sem I ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)) ?myω) ∈ fml_sem I (Pc pid1))"
        apply(rule coincidence_formula)
          subgoal by simp
         subgoal by (rule Iagree_refl)
        by(simp add: Vagree_def)
      have notin1:"Inl vid1 ∉ BVO ODE" using disj by auto
      have notin2:"Inr vid1 ∉ BVO ODE" using disj by auto
      have ODE_sem:"ODE_sem I ODE (sol t) $ vid1 = 0"
        using ODE_zero notin1 notin2 
        by blast 
      have vec_eq:"
      (χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
             (mk_v I (OProd  (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t))) =
      (χ i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (sol t))"
        apply(rule vec_extensionality)
        using mk_v_agree[of I "(OProd  (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE)" "(ab, bb)" "(sol t)"]
        by (simp add: Vagree_def)
      have sem_eq:
        "(repd ?myω vid1 (dterm_sem I ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)) ?myω) ∈ fml_sem I (Pc pid1)) 
     = (mk_v I (OProd  (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t) ∈ fml_sem I (Pc pid1)) "
        apply(rule coincidence_formula)
          subgoal by simp
         subgoal by (rule Iagree_refl)
        using mk_v_agree[of I "(OProd  (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE)" "(ab, bb)" "(sol t)"]
        unfolding Vagree_def apply simp
        apply(erule conjE)+
        apply(erule allE[where x=vid1])+
        by (simp add: ODE_sem vec_eq)
      have some_sem:"repd (mk_v I (OProd  (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t)) vid1
                (dterm_sem I ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))
                  (mk_v I (OProd  (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t))) ∈ fml_sem I (Pc pid1)"
        using rep_sem_eq 
        using all bigEx by blast
      have bigImp:"(∀ω'. ω' = repd ?myω vid1 (dterm_sem I ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)) ?myω) ⟶ ω' ∈ fml_sem I (Pc pid1))"
        apply(rule allI)
        apply(rule impI)
        apply auto
        using some_sem by auto
      have fml_sem:"repd ?myω vid1 (dterm_sem I ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)) ?myω) ∈ fml_sem I (Pc pid1)"
        using sem_eq bigImp by blast
     show "mk_v I (OProd  (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t) ∈ fml_sem I (Pc pid1)"
       using fml_sem sem_eq by blast
   qed
qed

lemma DC_valid:"valid DCaxiom" 
proof (auto simp only: fml_sem.simps prog_sem.simps DCaxiom_def valid_def iff_sem impl_sem box_sem, auto)
  fix I::"('sf,'sc,'sz) interp" and aa ba bb sol t
  assume "is_interp I"
    and all3:"∀a b. (∃sola. sol 0 = sola 0 ∧
                  (∃t. (a, b) = mk_v I (OVar vid1) (sola 0, bb) (sola t) ∧
                        0 ≤ t ∧ (sola solves_ode (λa. ODEs I vid1)) {0..t} {x. mk_v I (OVar vid1) (sola 0, bb) x ∈ Contexts I pid1 UNIV})) ⟶
           (a, b) ∈ Contexts I pid3 UNIV"
    and all2:"∀a b. (∃sola. sol 0 = sola 0 ∧
                   (∃t. (a, b) = mk_v I (OVar vid1) (sola 0, bb) (sola t) ∧
                        0 ≤ t ∧ (sola solves_ode (λa. ODEs I vid1)) {0..t} {x. mk_v I (OVar vid1) (sola 0, bb) x ∈ Contexts I pid1 UNIV})) ⟶
           (a, b) ∈ Contexts I pid2 UNIV"
    and t:"0 ≤ t"
    and aaba:"(aa, ba) = mk_v I (OVar vid1) (sol 0, bb) (sol t)"
    and sol:"(sol solves_ode (λa. ODEs I vid1)) {0..t}
       {x. mk_v I (OVar vid1) (sol 0, bb) x ∈ Contexts I pid1 UNIV ∧ mk_v I (OVar vid1) (sol 0, bb) x ∈ Contexts I pid3 UNIV}"
    from sol have
          sol1:"(sol solves_ode (λa. ODEs I vid1)) {0..t} {x. mk_v I (OVar vid1) (sol 0, bb) x ∈ Contexts I pid1 UNIV}"
      by (metis (mono_tags, lifting) Collect_mono solves_ode_supset_range)
    from all2 have all2':"⋀v. (∃sola. sol 0 = sola 0 ∧
                   (∃t. v = mk_v I (OVar vid1) (sola 0, bb) (sola t) ∧
                        0 ≤ t ∧ (sola solves_ode (λa. ODEs I vid1)) {0..t} {x. mk_v I (OVar vid1) (sola 0, bb) x ∈ Contexts I pid1 UNIV})) ⟹
           v ∈ Contexts I pid2 UNIV" by auto
    show "mk_v I (OVar vid1) (sol 0, bb) (sol t) ∈ Contexts I pid2 UNIV" 
      apply(rule all2'[of "mk_v I (OVar vid1) (sol 0, bb) (sol t)"])
      apply(rule exI[where x=sol])
      apply(rule conjI)
       subgoal by (rule refl)
      subgoal using t sol1 by auto
     done
next
  fix I::"('sf,'sc,'sz) interp" and  aa ba bb sol t
  assume "is_interp I"
  and all3:"∀a b. (∃sola. sol 0 = sola 0 ∧
                (∃t. (a, b) = mk_v I (OVar vid1) (sola 0, bb) (sola t) ∧
                     0 ≤ t ∧ (sola solves_ode (λa. ODEs I vid1)) {0..t} {x. mk_v I (OVar vid1) (sola 0, bb) x ∈ Contexts I pid1 UNIV})) ⟶
        (a, b) ∈ Contexts I pid3 UNIV"
  and all2:"∀a b. (∃sola. sol 0 = sola 0 ∧
                (∃t. (a, b) = mk_v I (OVar vid1) (sola 0, bb) (sola t) ∧
                     0 ≤ t ∧
                     (sola solves_ode (λa. ODEs I vid1)) {0..t}
                       {x. mk_v I (OVar vid1) (sola 0, bb) x ∈ Contexts I pid1 UNIV ∧
                          mk_v I (OVar vid1) (sola 0, bb) x ∈ Contexts I pid3 UNIV})) ⟶
        (a, b) ∈ Contexts I pid2 UNIV"
  and t:"0 ≤ t"
  and aaba:"(aa, ba) = mk_v I (OVar vid1) (sol 0, bb) (sol t)"
  and sol:"(sol solves_ode (λa. ODEs I vid1)) {0..t} {x. mk_v I (OVar vid1) (sol 0, bb) x ∈ Contexts I pid1 UNIV}"
  from all2 
  have all2':"⋀v. (∃sola. sol 0 = sola 0 ∧
                (∃t. v = mk_v I (OVar vid1) (sola 0, bb) (sola t) ∧
                     0 ≤ t ∧
                     (sola solves_ode (λa. ODEs I vid1)) {0..t}
                      {x. mk_v I (OVar vid1) (sola 0, bb) x ∈ Contexts I pid1 UNIV ∧
                          mk_v I (OVar vid1) (sola 0, bb) x ∈ Contexts I pid3 UNIV})) ⟹
        v ∈ Contexts I pid2 UNIV"
    by auto
  from all3
  have all3':"⋀v. (∃sola. sol 0 = sola 0 ∧
                (∃t. v = mk_v I (OVar vid1) (sola 0, bb) (sola t) ∧
                     0 ≤ t ∧ (sola solves_ode (λa. ODEs I vid1)) {0..t} {x. mk_v I (OVar vid1) (sola 0, bb) x ∈ Contexts I pid1 UNIV})) ⟹
        v ∈ Contexts I pid3 UNIV"
    by auto
  have inp1:"⋀s. 0 ≤ s ⟹ s ≤ t ⟹ mk_v I (OVar vid1) (sol 0, bb) (sol s) ∈ Contexts I pid1 UNIV"
    using sol solves_odeD atLeastAtMost_iff by blast
  have inp3:"⋀s. 0 ≤ s ⟹ s ≤ t ⟹ mk_v I (OVar vid1) (sol 0, bb) (sol s) ∈ Contexts I pid3 UNIV"
    apply(rule all3')
    subgoal for s 
      apply(rule exI [where x=sol])
      apply(rule conjI)
       subgoal by (rule refl)
      apply(rule exI [where x=s])
      apply(rule conjI)
       subgoal by (rule refl)
      apply(rule conjI)
       subgoal by assumption
      subgoal using sol by (meson atLeastatMost_subset_iff order_refl solves_ode_subset)
      done
   done
   have inp13:"⋀s. 0 ≤ s ⟹ s ≤ t ⟹ mk_v I (OVar vid1) (sol 0, bb) (sol s) ∈ Contexts I pid1 UNIV ∧ mk_v I (OVar vid1) (sol 0, bb) (sol s) ∈ Contexts I pid3 UNIV"
     using inp1 inp3 by auto
   have sol13:"(sol solves_ode (λa. ODEs I vid1)) {0..t}
     {x. mk_v I (OVar vid1) (sol 0, bb) x ∈ Contexts I pid1 UNIV ∧ mk_v I (OVar vid1) (sol 0, bb) x ∈ Contexts I pid3 UNIV}"
     apply(rule solves_odeI)
      subgoal using sol by (rule solves_odeD)
     subgoal for s using inp13[of s] by auto
     done
  show "mk_v I (OVar vid1) (sol 0, bb) (sol t) ∈ Contexts I pid2 UNIV"
    using t sol13 all2'[of "mk_v I (OVar vid1) (sol 0, bb) (sol t)"] by auto
qed

lemma DS_valid:"valid DSaxiom"
proof -
  have dsafe:"dsafe($f fid1 (λi. Const 0))"
    using dsafe_Const by auto
  have osafe:"osafe(OSing vid1 (f0 fid1))"
    unfolding f0_def empty_def
    using dsafe osafe.intros
    by (simp add: osafe_Sing dfree_Const)
  have fsafe:"fsafe(p1 vid2 vid1)"
    unfolding p1_def
    apply(rule fsafe_Prop)
    using singleton.simps dsafe_Const by (auto intro: dfree.intros)
  show "valid DSaxiom"
    apply(auto simp only: DSaxiom_def valid_def Let_def iff_sem impl_sem box_sem)
     apply(auto simp only: fml_sem.simps prog_sem.simps mem_Collect_eq  iff_sem impl_sem box_sem forall_sem)
  proof -
    fix I::"('sf,'sc,'sz) interp" 
      and a b r aa ba
    assume good_interp:"is_interp I"
    assume allW:"∀ω. (∃ν sol t.
             ((a, b), ω) = (ν, mk_v I (OSing vid1 (f0 fid1)) ν (sol t)) ∧
             0 ≤ t ∧
             (sol solves_ode (λ_. ODE_sem I (OSing vid1 (f0 fid1)))) {0..t}
              {x. mk_v I (OSing vid1 (f0 fid1)) ν x ∈ fml_sem I (p1 vid2 vid1)} ∧
              (sol 0) = (fst ν)) ⟶
         ω ∈ fml_sem I (p1 vid3 vid1)"
    assume "dterm_sem I (Const 0) (repv (a, b) vid2 r) ≤ dterm_sem I (trm.Var vid2) (repv (a, b) vid2 r)"
    hence leq:"0 ≤ r" by (auto)
    assume "∀ra. repv (repv (a, b) vid2 r) vid3 ra
         ∈ {v. dterm_sem I (Const 0) v ≤ dterm_sem I (trm.Var vid3) v} ∩
            {v. dterm_sem I (trm.Var vid3) v ≤ dterm_sem I (trm.Var vid2) v} ⟶
         Predicates I vid2
          (χ i. dterm_sem I (singleton (Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid3))) i)
                 (repv (repv (a, b) vid2 r) vid3 ra))"
    hence constraint:"∀ra. (0 ≤ ra ∧ ra ≤ r) ⟶ 
         (repv (repv (a, b) vid2 r) vid3 ra) 
       ∈ fml_sem I (Prop vid2 (singleton (Plus (Var vid1) (Times (f0 fid1) (Var vid3)))))"
      using leq by auto
    assume aaba:" (aa, ba) =
     repv (repv (a, b) vid2 r) vid1
      (dterm_sem I (Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid2))) (repv (a, b) vid2 r))"
    let ?abba = "repv (repd (a, b) vid1 (Functions I fid1 (χ i. 0))) vid1
      (dterm_sem I (Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid2))) (repv (a, b) vid2 r))"
    from allW have thisW:"(∃ν sol t.
            ((a, b), ?abba) = (ν, mk_v I (OSing vid1 (f0 fid1)) ν (sol t)) ∧
            0 ≤ t ∧
            (sol solves_ode (λ_. ODE_sem I (OSing vid1 (f0 fid1)))) {0..t}
             {x. mk_v I (OSing vid1 (f0 fid1)) ν x ∈ fml_sem I (p1 vid2 vid1)} ∧
             (sol 0) = (fst ν)) ⟶
        ?abba ∈ fml_sem I (p1 vid3 vid1)" by blast
    let ?c = "Functions I fid1 (χ _. 0)"
    let ?sol = "(λt. χ i. if i = vid1 then (a $ i) + ?c * t else (a $ i))"
    have agrees:"Vagree (mk_v I (OSing vid1 (f0 fid1)) (a, b) (?sol r)) (a, b) (- semBV I (OSing vid1 (f0 fid1))) 
  ∧ Vagree (mk_v I (OSing vid1 (f0 fid1)) (a, b) (?sol r))
   (mk_xode I (OSing vid1 (f0 fid1)) (?sol r)) (semBV I (OSing vid1 (f0 fid1)))" 
       using mk_v_agree[of "I" "(OSing vid1 (f0 fid1))" "(a,b)" "(?sol r)"] by auto
    have prereq1a:"fst ?abba
     = fst (mk_v I (OSing vid1 (f0 fid1)) (a,b) (?sol r))"
      using  agrees aaba 
      apply (auto simp add: aaba Vagree_def)
       apply (rule vec_extensionality)
       subgoal for i
         apply (cases "i = vid1")
          using vne12 agrees Vagree_def apply (auto simp add: aaba f0_def empty_def)
         done
      apply (rule vec_extensionality)
      subgoal for i
        apply (cases "i = vid1")
         apply(auto  simp add: f0_def empty_def)
      done
    done
  have prereq1b:"snd (?abba) = snd (mk_v I (OSing vid1 (f0 fid1)) (a,b) (?sol r))"
    using agrees aaba 
    apply (auto simp add: aaba Vagree_def)
    apply (rule vec_extensionality)
    subgoal for i
      apply (cases "i = vid1")
       using vne12 agrees Vagree_def apply (auto simp add: aaba f0_def empty_def )
      done
    done  
  have "?abba = mk_v I (OSing vid1 (f0 fid1)) (a,b) (?sol r)"
    using prod_eq_iff prereq1a prereq1b by blast
  hence req1:"((a, b), ?abba) = ((a, b), mk_v I (OSing vid1 (f0 fid1)) (a,b) (?sol r))" by auto
  have "sterm_sem I ($f fid1 (λi. Const 0)) b = Functions I fid1 (χ i. 0)" by auto
  hence vec_simp:"(λa b. χ i. if i = vid1 then sterm_sem I ($f fid1 (λi. Const 0)) b else 0) 
      = (λa b. χ i. if i = vid1 then Functions I fid1 (χ i. 0) else 0)"
    by (auto simp add: vec_eq_iff cong: if_cong)
  have sub: "{0..r} ⊆ UNIV" by auto
  have sub2:"{x. mk_v I (OSing vid1 (f0 fid1)) (a,b) x ∈ fml_sem I (p1 vid2 vid1)} ⊆ UNIV" by auto
  have req3:"(?sol solves_ode (λ_. ODE_sem I (OSing vid1 (f0 fid1)))) {0..r}
            {x. mk_v I (OSing vid1 (f0 fid1)) (a,b) x ∈ fml_sem I (p1 vid2 vid1)}" 
    apply(auto simp add: f0_def empty_def vec_simp) 
    apply(rule solves_odeI)
     apply(auto simp only: has_vderiv_on_def has_vector_derivative_def box_sem)
     apply (rule has_derivative_vec[THEN has_derivative_eq_rhs])
      defer
      apply (rule ext)
      apply (subst scaleR_vec_def)
      apply (rule refl)
     apply (auto intro!: derivative_eq_intros)
    ― ‹Domain constraint satisfied›
    using constraint apply (auto)
    subgoal for t
      apply(erule allE[where x="t"])
      apply(auto simp add: p1_def)
    proof -
      have eq:"(χ i. dterm_sem I (if i = vid1 then Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid3)) else Const 0)
            (χ y. if vid3 = y then t else fst (χ y. if vid2 = y then r else fst (a, b) $ y, b) $ y, b)) =
            (χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
              (mk_v I (OSing vid1 ($f fid1 (λi. Const 0))) (a, b)
                (χ i. if i = vid1 then a $ i + Functions I fid1 (χ _. 0) * t else a $ i)))"
        using vne12 vne13 mk_v_agree[of "I" "(OSing vid1 ($f fid1 (λi. Const 0)))" "(a, b)" "(χ i. if i = vid1 then a $ i + Functions I fid1 (χ _. 0) * t else a $ i)"]
        by (auto simp add: vec_eq_iff f0_def empty_def Vagree_def)
      show "0 ≤ t ⟹
    t ≤ r ⟹
    Predicates I vid2
     (χ i. dterm_sem I (if i = vid1 then Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid3)) else Const 0)
            (χ y. if vid3 = y then t else fst (χ y. if vid2 = y then r else fst (a, b) $ y, b) $ y, b)) ⟹
    Predicates I vid2
     (χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
            (mk_v I (OSing vid1 ($f fid1 (λi. Const 0))) (a, b)
              (χ i. if i = vid1 then a $ i + Functions I fid1 (χ _. 0) * t else a $ i)))" 
        using eq by auto
    qed
    done
  have req4':"?sol 0 = fst (a,b)" by (auto simp: vec_eq_iff)
  then have req4: " (?sol 0) = (fst (a,b))"
    using VSagree_refl[of a] req4' unfolding VSagree_def by auto
  have inPred:"?abba ∈ fml_sem I (p1 vid3 vid1)"  
    using req1 leq req3 req4 thisW by fastforce
  have sem_eq:"?abba ∈ fml_sem I (p1 vid3 vid1) ⟷ (aa,ba) ∈ fml_sem I (p1 vid3 vid1)"
    apply (rule coincidence_formula)
      apply (auto simp add: aaba Vagree_def p1_def f0_def empty_def)
    subgoal using Iagree_refl by auto
    done
  from inPred sem_eq have  inPred':"(aa,ba) ∈ fml_sem I (p1 vid3 vid1)"
    by auto
  ― ‹thus by lemma 6 consequence for formulas›
  show "repv (repv (a, b) vid2 r) vid1
       (dterm_sem I (Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid2))) (repv (a, b) vid2 r))
       ∈ fml_sem I (p1 vid3 vid1)" 
    using aaba inPred' by (auto)
next
  fix I::"('sf,'sc,'sz) interp"
  and aa ba ab bb sol 
  and t:: real
  assume good_interp:"is_interp I"
  assume all:"
       ∀r. dterm_sem I (Const 0) (repv (ab, bb) vid2 r) ≤ dterm_sem I (trm.Var vid2) (repv (ab, bb) vid2 r) ⟶
           (∀ra. repv (repv (ab, bb) vid2 r) vid3 ra
                 ∈ {v. dterm_sem I (Const 0) v ≤ dterm_sem I (trm.Var vid3) v} ∩
                    {v. dterm_sem I (trm.Var vid3) v ≤ dterm_sem I (trm.Var vid2) v} ⟶
                 Predicates I vid2
                  (χ i. dterm_sem I (singleton (Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid3))) i)
                         (repv (repv (ab, bb) vid2 r) vid3 ra))) ⟶
                         
           (∀ω. ω = repv (repv (ab, bb) vid2 r) vid1
                      (dterm_sem I (Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid2))) (repv (ab, bb) vid2 r)) ⟶
                 ω ∈ fml_sem I (p1 vid3 vid1))"
  assume t:"0 ≤ t"
  assume aaba:"(aa, ba) = mk_v I (OSing vid1 (f0 fid1)) (ab, bb) (sol t)"
  assume sol:"(sol solves_ode (λ_. ODE_sem I (OSing vid1 (f0 fid1)))) {0..t}
        {x. mk_v I (OSing vid1 (f0 fid1)) (ab, bb) x ∈ fml_sem I (p1 vid2 vid1)}"
  hence constraint:"⋀s. s ∈ {0 .. t} ⟹ sol s ∈ {x. mk_v I (OSing vid1 (f0 fid1)) (ab, bb) x ∈ fml_sem I (p1 vid2 vid1)}"
    using solves_ode_domainD by fastforce
  ― ‹‹sol 0 = fst (ab, bb)››
  assume sol0:"  (sol 0) = (fst (ab, bb)) "
  have impl:"dterm_sem I (Const 0) (repv (ab, bb) vid2 t) ≤ dterm_sem I (trm.Var vid2) (repv (ab, bb) vid2 t) ⟶
           (∀ra. repv (repv (ab, bb) vid2 t) vid3 ra
                 ∈ {v. dterm_sem I (Const 0) v ≤ dterm_sem I (trm.Var vid3) v} ∩
                    {v. dterm_sem I (trm.Var vid3) v ≤ dterm_sem I (trm.Var vid2) v} ⟶
                 Predicates I vid2
                  (χ i. dterm_sem I (singleton (Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid3))) i)
                         (repv (repv (ab, bb) vid2 t) vid3 ra))) ⟶
           (∀ω. ω = repv (repv (ab, bb) vid2 t) vid1
                      (dterm_sem I (Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid2))) (repv (ab, bb) vid2 t)) ⟶
                 ω ∈ fml_sem I (p1 vid3 vid1))" using all by auto
  interpret ll:ll_on_open_it UNIV "(λ_. ODE_sem I (OSing vid1 (f0 fid1)))" "UNIV" 0
    apply(standard)
        apply(auto)
     unfolding local_lipschitz_def f0_def empty_def sterm_sem.simps 
     using gt_ex lipschitz_on_constant by blast
  have eq_UNIV:"ll.existence_ivl 0 (sol 0) = UNIV"
    apply(rule ll.existence_ivl_eq_domain)
        apply(auto)
    subgoal for tm tM t
      apply(unfold f0_def empty_def sterm_sem.simps)
      by(metis add.right_neutral mult_zero_left order_refl)
    done
  ― ‹Combine with ‹flow_usolves_ode› and ‹equals_flowI› to get uniqueness of solution›
  let ?f = "(λ_. ODE_sem I (OSing vid1 (f0 fid1)))"
  have sol_UNIV: "⋀t x. (ll.flow 0 x usolves_ode ?f from 0) (ll.existence_ivl 0 x) UNIV"
    using ll.flow_usolves_ode by auto    
  from sol have sol':
    "(sol solves_ode (λ_. ODE_sem I (OSing vid1 (f0 fid1)))) {0..t} UNIV"
    apply (rule solves_ode_supset_range)
    by auto
  from sol' have sol'':"⋀s. s ≥ 0 ⟹ s ≤ t ⟹ (sol solves_ode (λ_. ODE_sem I (OSing vid1 (f0 fid1)))) {0..s} UNIV"
    by (simp add: solves_ode_subset)
  have sol0_eq:"sol 0 = ll.flow  0 (sol 0) 0"
    using ll.general.flow_initial_time_if by auto
  have isFlow:"⋀s. s ≥ 0 ⟹ s ≤ t ⟹ sol s = ll.flow 0 (sol 0) s"
    apply(rule ll.equals_flowI)
         apply(auto)
      subgoal using eq_UNIV by auto
     subgoal using sol'' closed_segment_eq_real_ivl t by (auto simp add: solves_ode_singleton)
    subgoal using eq_UNIV sol sol0_eq by auto
    done
  let ?c = "Functions I fid1 (χ _. 0)"
  let ?sol = "(λt. χ i. if i = vid1 then (ab $ i) + ?c * t else (ab $ i))"
  have vec_simp:"(λa b. χ i. if i = vid1 then sterm_sem I ($f fid1 (λi. Const 0)) b else 0) 
      = (λa b. χ i. if i = vid1 then Functions I fid1 (χ i. 0) else 0)"
    by (auto simp add: vec_eq_iff cong: if_cong)
  have exp_sol:"(?sol solves_ode (λ_. ODE_sem I (OSing vid1 (f0 fid1)))) {0..t}
    UNIV"
    apply(auto simp add: f0_def empty_def vec_simp) 
    apply(rule solves_odeI)
     apply(auto simp only: has_vderiv_on_def has_vector_derivative_def box_sem)
    apply (rule has_derivative_vec[THEN has_derivative_eq_rhs])
     defer
     apply (rule ext)
     apply (subst scaleR_vec_def)
     apply (rule refl)
    apply (auto intro!: derivative_eq_intros)
    done
  from exp_sol have exp_sol':"⋀s. s ≥ 0 ⟹ s ≤ t ⟹ (?sol solves_ode (λ_. ODE_sem I (OSing vid1 (f0 fid1)))) {0..s} UNIV"
    by (simp add: solves_ode_subset)
  have exp_sol0_eq:"?sol 0 = ll.flow  0 (?sol 0) 0"
    using ll.general.flow_initial_time_if by auto
  have more_eq:"(χ i. if i = vid1 then ab $ i + Functions I fid1 (χ _. 0) * 0 else ab $ i) = sol 0"
    using sol0 
    apply auto 
    apply(rule vec_extensionality)
    by(auto)
  have exp_isFlow:"⋀s. s ≥ 0 ⟹ s ≤ t ⟹ ?sol s = ll.flow 0 (sol 0) s"
    apply(rule ll.equals_flowI)
         apply(auto)
      subgoal using eq_UNIV by auto
     defer
     subgoal for s 
       using eq_UNIV apply auto
       subgoal using exp_sol exp_sol0_eq more_eq 
         apply(auto)
         done
       done
    using exp_sol' closed_segment_eq_real_ivl t apply(auto)
    by (simp add: solves_ode_singleton)
  have sol_eq_exp:"⋀s. s ≥ 0 ⟹ s ≤ t ⟹ ?sol s = sol s"
    unfolding exp_isFlow isFlow by auto
  then have sol_eq_exp_t:"?sol t = sol t"
    using t by auto
  then have sol_eq_exp_t':"sol t $ vid1 = ?sol t $ vid1" by auto
  then have useful:"?sol t $ vid1 = ab $ vid1 + Functions I fid1 (χ i. 0) * t"
    by auto
  from sol_eq_exp_t' useful have useful':"sol t $ vid1 = ab $ vid1 + Functions I fid1 (χ i. 0) * t"
    by auto
  have sol_int:"((ll.flow 0 (sol 0)) usolves_ode ?f from 0) {0..t} {x. mk_v I (OSing vid1 (f0 fid1)) (ab, bb) x ∈ fml_sem I (p1 vid2 vid1)}"
    apply (rule usolves_ode_subset_range[of "(ll.flow 0 (sol 0))" "?f" "0" "{0..t}" "UNIV" "{x. mk_v I (OSing vid1 (f0 fid1)) (ab, bb) x ∈ fml_sem I (p1 vid2 vid1)}"]) 
      subgoal using eq_UNIV sol_UNIV[of "(sol 0)"] apply (auto)
        apply (rule usolves_ode_subset)
           using t by(auto)
    apply(auto)
    using sol apply(auto  dest!: solves_ode_domainD)
    subgoal for xa using isFlow[of xa] by(auto)
    done
  have thing:"⋀s. 0 ≤ s ⟹ s ≤ t ⟹ fst (mk_v I (OSing vid1 ($f fid1 (λi. Const 0))) (ab, bb) (?sol s)) $ vid1 = ab $ vid1 + Functions I fid1 (χ i. 0) * s"
    subgoal for s
      using mk_v_agree[of I "(OSing vid1 ($f fid1 (λi. Const 0)))" "(ab, bb)" "(?sol s)"] apply auto
      unfolding Vagree_def by auto
    done
  have thing':"⋀s. 0 ≤ s ⟹ s ≤ t ⟹  fst (mk_v I (OSing vid1 ($f fid1 (λi. Const 0))) (ab, bb) (sol s)) $ vid1 = ab $ vid1 + Functions I fid1 (χ i. 0) * s"
    subgoal for s using thing[of s] sol_eq_exp[of s] by auto done
  have another_eq:"⋀i s. 0 ≤ s ⟹ s ≤ t ⟹ dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                (mk_v I (OSing vid1 (f0 fid1)) (ab, bb) (sol s))

        =  dterm_sem I (if i = vid1 then Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid3)) else Const 0)
                (χ y. if vid3 = y then s else fst (χ y. if vid2 = y then s else fst (ab, bb) $ y, bb) $ y, bb)"
    using mk_v_agree[of "I" "(OSing vid1 (f0 fid1))" "(ab, bb)" "(sol s)"]  vne12 vne23 vne13
    apply(auto simp add: f0_def p1_def empty_def)
    unfolding Vagree_def apply(simp add: f0_def empty_def)
    subgoal for s using thing' by auto
    done
  have allRa':"(∀ra. repv (repv (ab, bb) vid2 t) vid3 ra
               ∈ {v. dterm_sem I (Const 0) v ≤ dterm_sem I (trm.Var vid3) v} ∩
                  {v. dterm_sem I (trm.Var vid3) v ≤ dterm_sem I (trm.Var vid2) v} ⟶
               Predicates I vid2
                (χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                (mk_v I (OSing vid1 (f0 fid1)) (ab, bb) (sol ra))))"
    apply(rule allI)
    subgoal for ra
      using mk_v_agree[of "I" "(OSing vid1 (f0 fid1))" "(ab, bb)" "(sol ra)"]
         vne23 constraint[of ra] apply(auto simp add: Vagree_def p1_def)
    done
  done
  have anotherFact:"⋀ra. 0 ≤ ra ⟹ ra ≤ t ⟹ (χ i. if i = vid1 then ab $ i + Functions I fid1 (χ _. 0) * ra else ab $ i) $ vid1 =
     ab $ vid1 + dterm_sem I (f0 fid1) (χ y. if vid3 = y then ra else fst (χ y. if vid2 = y then t else fst (ab, bb) $ y, bb) $ y, bb) * ra "
    subgoal for ra
      apply simp
      apply(rule disjI2)
      by (auto simp add: f0_def empty_def)
    done
  have thing':"⋀ra i. 0 ≤ ra ⟹ ra ≤ t ⟹ dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (mk_v I (OSing vid1 ($f fid1 (λi. Const 0))) (ab, bb) (sol ra))
      =  dterm_sem I (if i = vid1 then Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid3)) else Const 0)
            (χ y. if vid3 = y then ra else fst (χ y. if vid2 = y then t else fst (ab, bb) $ y, bb) $ y, bb) "
    subgoal for ra i
      using vne12 vne13 mk_v_agree[of I "OSing vid1 ($f fid1 (λi. Const 0))" "(ab,bb)" "(sol ra)"] 
      apply (auto)
      unfolding Vagree_def apply(safe)
      apply(erule allE[where x="vid1"])+
      using sol_eq_exp[of ra] anotherFact[of ra] by auto
    done
  have allRa:"(∀ra. repv (repv (ab, bb) vid2 t) vid3 ra
               ∈ {v. dterm_sem I (Const 0) v ≤ dterm_sem I (trm.Var vid3) v} ∩
                  {v. dterm_sem I (trm.Var vid3) v ≤ dterm_sem I (trm.Var vid2) v} ⟶
               Predicates I vid2
                (χ i. dterm_sem I (singleton (Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid3))) i)
                       (repv (repv (ab, bb) vid2 t) vid3 ra)))"
    apply(rule allI)
    subgoal for ra
      using mk_v_agree[of "I" "(OSing vid1 (f0 fid1))" "(ab, bb)" "(sol ra)"]
         vne23 constraint[of ra] apply(auto simp add: Vagree_def p1_def)
      using sol_eq_exp[of ra]  apply (auto simp add: f0_def empty_def Vagree_def vec_eq_iff)
      using thing' by auto
    done
  have fml3:"⋀ra. 0 ≤ ra ⟹ ra ≤ t ⟹
           (∀ω. ω = repv (repv (ab, bb) vid2 t) vid1
                      (dterm_sem I (Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid2))) (repv (ab, bb) vid2 t)) ⟶
                 ω ∈ fml_sem I (p1 vid3 vid1))"
    using impl allRa by auto       
  have someEq:"(χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
            (χ y. if vid1 = y then (if vid2 = vid1 then t else fst (ab, bb) $ vid1) + Functions I fid1 (χ i. 0) * t
                  else fst (χ y. if vid2 = y then t else fst (ab, bb) $ y, bb) $ y,
             bb)) 
             = (χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (mk_v I (OSing vid1 ($f fid1 (λi. Const 0))) (ab, bb) (sol t)))"
    apply(rule vec_extensionality)
    using vne12 sol_eq_exp t thing by auto
  show "mk_v I (OSing vid1 (f0 fid1)) (ab, bb) (sol t) ∈ fml_sem I (p1 vid3 vid1)"
    using mk_v_agree[of I "OSing vid1 (f0 fid1)" "(ab, bb)" "sol t"] fml3[of t]
    unfolding f0_def p1_def empty_def Vagree_def 
    using someEq by(auto simp add:  sol_eq_exp_t' t vec_extensionality  vne12)
qed qed

lemma MVT0_within:
  fixes f ::"real ⇒ real"
    and f'::"real ⇒ real ⇒ real"
    and s t :: real
  assumes f':"⋀x. x ∈ {0..t} ⟹ (f has_derivative (f' x)) (at x  within {0..t})"
  assumes geq':"⋀x. x ∈ {0..t} ⟹ f' x s ≥ 0"
  assumes int_s:"s > 0 ∧ s ≤ t"
  assumes t: "0 < t"
  shows "f s ≥ f 0"
proof -
  have "f 0 + 0 ≤ f s"   
    apply (rule Lib.MVT_ivl'[OF f', of 0 s 0])
      subgoal for x by assumption
     subgoal for x using geq' by auto 
    using t int_s t apply auto
    subgoal for x
      by (metis int_s mult.commute mult.right_neutral order.trans mult_le_cancel_iff2)
    done
  then show "?thesis" by auto 
qed

lemma MVT':
  fixes f g ::"real ⇒ real"
  fixes f' g'::"real ⇒ real ⇒ real"
  fixes s t ::real
  assumes f':"⋀s. s ∈ {0..t} ⟹ (f has_derivative (f' s)) (at s within {0..t})"
  assumes g':"⋀s. s ∈ {0..t} ⟹ (g has_derivative (g' s)) (at s within {0..t})"
  assumes geq':"⋀x. x ∈ {0..t} ⟹ f' x s ≥ g' x s"
  assumes geq0:"f 0 ≥ g 0"
  assumes int_s:"s > 0 ∧ s ≤ t"
  assumes t:"t > 0"
  shows "f s ≥ g s"
proof -
  let ?h = "(λx. f x - g x)"
  let ?h' = "(λs x. f' s x - g' s x)"
  have "?h s ≥ ?h 0"
    apply(rule MVT0_within[of t ?h "?h'" s])
       subgoal for s using f'[of s] g'[of s] by auto
      subgoal for sa using geq'[of sa] by auto
     subgoal using int_s by auto
    subgoal using t by auto
    done
  then show "?thesis" using geq0 by auto
qed

lemma MVT'_gr:
  fixes f g ::"real ⇒ real"
  fixes f' g'::"real ⇒ real ⇒ real"
  fixes s t ::real
  assumes f':"⋀s. s ∈ {0..t} ⟹ (f has_derivative (f' s)) (at s within {0..t})"
  assumes g':"⋀s. s ∈ {0..t} ⟹ (g has_derivative (g' s)) (at s within {0..t})"
  assumes geq':"⋀x. x ∈ {0..t} ⟹ f' x s ≥ g' x s"
  assumes geq0:"f 0 > g 0"
  assumes int_s:"s > 0 ∧ s ≤ t"
  assumes t:"t > 0"
  shows "f s > g s"
proof -
  let ?h = "(λx. f x - g x)"
  let ?h' = "(λs x. f' s x - g' s x)"
  have "?h s ≥ ?h 0"
    apply(rule MVT0_within[of t ?h "?h'" s])
       subgoal for s using f'[of s] g'[of s] by auto
      subgoal for sa using geq'[of sa] by auto
     subgoal using int_s by auto
    subgoal using t by auto
    done
  then show "?thesis" using geq0 by auto
qed

lemma frech_linear:
  fixes x θ ν ν' I
  assumes good_interp:"is_interp I"
  assumes free:"dfree θ"
  shows "x * frechet I θ ν ν' = frechet I θ ν (x *⇩_R ν')"
  using frechet_linear[OF good_interp free]
  by (simp add: linear_simps)
    
lemma rift_in_space_time:
  fixes sol I ODE ψ θ t s b
  assumes good_interp:"is_interp I"
  assumes free:"dfree θ"
  assumes osafe:"osafe ODE"
  assumes sol:"(sol solves_ode (λ_ ν'. ODE_sem I ODE ν')) {0..t} 
          {x. mk_v I ODE (sol 0, b) x ∈ fml_sem I ψ}"
  assumes FVT:"FVT θ ⊆ semBV I ODE"  
  assumes ivl:"s ∈ {0..t}"
  shows "((λt. sterm_sem I θ (fst (mk_v I ODE (sol 0, b) (sol t))))
    ― ‹This is Frechet derivative, so equivalent to:›
    ― ‹‹has_real_derivative frechet I θ (fst((mk_v I ODE (sol 0, b) (sol s)))) (snd (mk_v I ODE (sol 0, b) (sol s))))) (at s within {0..t})››
    has_derivative (λt'. t' * frechet I θ (fst((mk_v I ODE (sol 0, b) (sol s)))) (snd (mk_v I ODE (sol 0, b) (sol s))))) (at s within {0..t})"
proof -
  let ?φ = "(λt. (mk_v I ODE (sol 0, b) (sol t)))"
  let ?φs = "(λt. fst (?φ t))"
  have sol_deriv:"⋀s. s ∈ {0..t} ⟹ (sol has_derivative (λxa. xa *⇩_R ODE_sem I ODE (sol s))) (at s within {0..t})"
    using sol apply simp 
    apply (drule solves_odeD(1))
    unfolding has_vderiv_on_def has_vector_derivative_def
    by auto
  have sol_dom:"⋀s. s∈ {0..t} ⟹ ?φ s ∈ fml_sem I ψ"
    using sol apply simp
    apply (drule solves_odeD(2))
     by auto
  let ?h = "(λt. sterm_sem I θ (?φs t))"
  let ?g = "(λν. sterm_sem I θ ν)"
  let ?f = "?φs"
  let ?f' = "(λt'. t' *⇩_R (χ i. if i ∈ ODE_vars I ODE then ODE_sem I ODE (sol s) $ i else 0))"
  let ?g' = "(frechet I θ (?φs s))"
  have heq:"?h = ?g ∘ ?f" by (auto)
  have fact1:"⋀i. i ∈ ODE_vars I ODE ⟹ (λt. ?φs(t) $ i) = (λt. sol t $ i)"
    subgoal for i
      apply(rule ext)
      subgoal for t
        using mk_v_agree[of I ODE "(sol 0, b)" "sol t"]
        unfolding Vagree_def by auto
      done done
  have fact2:"⋀i. i ∈ ODE_vars I ODE ⟹ (λt. if i ∈ ODE_vars I ODE then ODE_sem I ODE (sol t) $ i else 0) = (λt. ODE_sem I ODE (sol t) $ i)"
    subgoal for i
      apply(rule ext)
      subgoal for t
        using mk_v_agree[of I ODE "(sol 0, b)" "sol t"]
        unfolding Vagree_def by auto
      done done
  have fact3:"⋀i. i ∈ (-ODE_vars I ODE) ⟹ (λt. ?φs(t) $ i) = (λt. sol 0 $ i)"
    subgoal for i
      apply(rule ext)
      subgoal for t
        using mk_v_agree[of I ODE "(sol 0, b)" "sol t"]
        unfolding Vagree_def by auto
      done done
  have fact4:"⋀i. i ∈ (-ODE_vars I ODE) ⟹ (λt. if i ∈ ODE_vars I ODE then ODE_sem I ODE (sol t) $ i else 0) = (λt. 0)"
    subgoal for i
      apply(rule ext)
      subgoal for t
        using mk_v_agree[of I ODE "(sol 0, b)" "sol t"]
        unfolding Vagree_def by auto
      done done
  have some_eq:"(λv'. χ i. v' *⇩_R ODE_sem I ODE (sol s) $ i) = (λv'. v' *⇩_R ODE_sem I ODE (sol s))"
    apply(rule ext)
    apply(rule vec_extensionality)
    by auto
  have some_sol:"(sol has_derivative (λv'. v' *⇩_R ODE_sem I ODE (sol s))) (at s within {0..t})"
    using sol ivl unfolding solves_ode_def has_vderiv_on_def has_vector_derivative_def by auto
  have some_eta:"(λt. χ i. sol t $ i) = sol" by (rule ext, rule vec_extensionality, auto)
  have ode_deriv:"⋀i. i ∈ ODE_vars I ODE ⟹ 
    ((λt. sol t $ i) has_derivative (λ v'. v' *⇩_R ODE_sem I ODE (sol s) $ i)) (at s within {0..t})"
    subgoal for i
      apply(rule has_derivative_proj)
      using some_eq some_sol some_eta by auto
    done
  have eta:"(λt. (χ i. ?f t $ i)) = ?f" by(rule ext, rule vec_extensionality, auto)
  have eta_esque:"(λt'. χ i. t' * (if i ∈ ODE_vars I ODE then ODE_sem I ODE (sol s) $ i else 0)) =  
                  (λt'. t' *⇩_R (χ i. if i ∈ ODE_vars I ODE then ODE_sem I ODE (sol s) $ i else 0))"
    apply(rule ext | rule vec_extensionality)+
    subgoal for t' i by auto done
  have "((λt. (χ i. ?f t $ i)) has_derivative (λt'. (χ i. ?f' t' $ i))) (at s within {0..t})"
    apply (rule has_derivative_vec)
    subgoal for i       
      apply(cases "i ∈ ODE_vars I ODE")
       subgoal using fact1[of i] fact2[of i] ode_deriv[of i] by auto 
      subgoal using fact3[of i] fact4[of i] by auto 
    done
  done
  then have fderiv:"(?f has_derivative ?f') (at s within {0..t})" using eta eta_esque by auto
  have gderiv:"(?g has_derivative ?g') (at (?f s) within ?f ` {0..t})"
     using has_derivative_at_withinI 
     using frechet_correctness free good_interp 
     by blast
  have chain:"((?g ∘ ?f) has_derivative (?g' ∘ ?f')) (at s within {0..t})"
    using fderiv gderiv diff_chain_within by blast
  let ?coν1 = "(fst (mk_v I ODE (sol 0, b) (sol s)), ODE_sem I ODE (fst (mk_v I ODE (sol 0, b) (sol s))))"
  let ?coν2 = "(fst (mk_v I ODE (sol 0, b) (sol s)), snd (mk_v I ODE (sol 0, b) (sol s)))"
  have sub_cont:"⋀a .a ∉ ODE_vars I ODE ⟹ Inl a ∈ FVT θ ⟹ False"
    using FVT by auto
  have sub_cont2:"⋀a .a ∉ ODE_vars I ODE ⟹ Inr a ∈ FVT θ ⟹ False"
    using FVT by auto
  have "Vagree (mk_v I ODE (sol 0, b) (sol s)) (sol s, b) (Inl ` ODE_vars I ODE)"
    using mk_v_agree[of I ODE "(sol 0, b)" "sol s"]
    unfolding Vagree_def by auto
  let ?co'ν1 = "(λx. (fst (mk_v I ODE (sol 0, b) (sol s)), x *⇩_R (χ i. if i ∈ ODE_vars I ODE then ODE_sem I ODE (sol s) $ i else 0)))"
  let ?co'ν2 = "(λx. (fst (mk_v I ODE (sol 0, b) (sol s)), x *⇩_R snd (mk_v I ODE (sol 0, b) (sol s))))"
  have co_agree_sem:"⋀s. Vagree (?co'ν1 s) (?co'ν2 s) (semBV I ODE)"
    subgoal for sa
      using mk_v_agree[of I ODE "(sol 0, b)" "sol s"]
      unfolding Vagree_def by auto
    done
  have co_agree_help:"⋀s. Vagree (?co'ν1 s) (?co'ν2 s) (FVT θ)"
    using agree_sub[OF FVT co_agree_sem] by auto
  have co_agree':"⋀s. Vagree (?co'ν1 s) (?co'ν2 s) (FVDiff θ)"
    subgoal for s
      using mk_v_agree[of I ODE "(sol 0, b)" "sol s"]
      unfolding Vagree_def apply auto
      subgoal for i x
        apply(cases x)
        subgoal for a
          apply(cases "a ∈ ODE_vars I ODE")
           by (simp | metis (no_types, lifting) FVT ODE_vars_lr Vagree_def mk_v_agree mk_xode.elims subsetD snd_conv)+
        subgoal for a
          apply(cases "a ∈ ODE_vars I ODE")
           by (simp | metis (no_types, lifting) FVT Vagree_def mk_v_agree mk_xode.elims subsetD snd_conv)+
        done
      subgoal for i x
        apply(cases x)
        subgoal for a
          apply(cases "a ∈ ODE_vars I ODE")
           using FVT ODE_vars_lr Vagree_def mk_v_agree mk_xode.elims subsetD snd_conv
           by auto
        subgoal for a
          apply(cases "a ∈ ODE_vars I ODE")
           apply(erule allE[where x=i])+
           using FVT ODE_vars_lr Vagree_def mk_v_agree mk_xode.elims subsetD snd_conv
           by auto
        done
      done
    done 
  have heq'':"(?g' ∘ ?f') = (λt'. t' *⇩_R frechet I θ (?φs s) (snd (?φ s)))"
    using mk_v_agree[of I ODE "(sol 0, b)" "sol s"]
    unfolding comp_def
    apply auto
    apply(rule ext | rule vec_extensionality)+
    subgoal for x
      using frech_linear[of I θ x "(fst (mk_v I ODE (sol 0, b) (sol s)))" "(snd (mk_v I ODE (sol 0, b) (sol s)))", OF good_interp free]
      using coincidence_frechet[OF free, of "(?co'ν1 x)" "(?co'ν2 x)", OF co_agree'[of x], of I]
      by auto
    done
  have "((?g ∘ ?f) has_derivative (?g' ∘ ?f')) (at s within {0..t})"
    using chain by auto
  then have "((?g ∘ ?f) has_derivative (λt'. t' * frechet I θ (?φs s) (snd (?φ s)))) (at s within {0..t})"
    using heq'' by auto
  then have result:"((λt. sterm_sem I θ (?φs t))  has_derivative (λt. t * frechet I θ (?φs s) (snd (?φ s)))) (at s within {0..t})"
    using heq by auto
  then show "?thesis" by auto
qed

lemma dterm_sterm_dfree:
   "dfree θ ⟹ (⋀ν ν'. sterm_sem I θ ν = dterm_sem I θ (ν, ν'))"
  by(induction rule: dfree.induct, auto)

― ‹‹g(x)≥ h(x) →  [x'=f(x), c & p(x)](g(x)' ≥ h(x)') → [x'=f(x), c]g(x) ≥ h(x)››  
lemma DIGeq_valid:"valid DIGeqaxiom"
  unfolding DIGeqaxiom_def
  apply(unfold DIGeqaxiom_def valid_def impl_sem iff_sem)
  apply(auto) (* 4 goals*)
  proof -
    fix I::"('sf,'sc,'sz) interp" and  b aa ba 
      and sol::"real ⇒ 'sz simple_state" 
      and t::real
    let ?ODE = "OVar vid1"
    let ?φ = "(λt. mk_v I (?ODE) (sol 0, b) (sol t))"
    assume t:"0 ≤ t"
      and sol:"(sol solves_ode (λa. ODEs I vid1)) {0..t}
      {x. Predicates I vid1 (χ i. dterm_sem I (empty i) (mk_v I ?ODE (sol 0, b) x))}"
      and notin:" ¬(Predicates I vid1 (χ i. dterm_sem I (empty i) (sol 0, b)))"
    have fsafe:"fsafe (Prop vid1 empty)" by (auto simp add: empty_def)
    from sol have "Predicates I vid1 (χ i. dterm_sem I (empty i) (?φ 0))"
      using t solves_ode_domainD[of sol "(λa. ODEs I vid1)" "{0..t}"]  by auto
    then have incon:"Predicates I vid1 (χ i. dterm_sem I (empty i) ((sol 0, b)))"
      using coincidence_formula[OF fsafe Iagree_refl[of I], of "(sol 0, b)" "?φ 0"]
      unfolding Vagree_def by (auto simp add: empty_def)
    show "dterm_sem I (f1 fid2 vid1)  (mk_v I (OVar vid1) (sol 0, b) (sol t)) ≤ dterm_sem I (f1 fid1 vid1) (mk_v I (OVar vid1) (sol 0, b) (sol t))"
      using notin incon by auto
  next
    fix I::"('sf,'sc,'sz) interp" and  b aa ba 
      and sol::"real ⇒ 'sz simple_state" 
      and t::real
    let ?ODE = "OVar vid1"
    let ?φ = "(λt. mk_v I (?ODE) (sol 0, b) (sol t))"
    assume t:"0 ≤ t"
      and sol:"(sol solves_ode (λa. ODEs I vid1)) {0..t}
      {x. Predicates I vid1 (χ i. dterm_sem I (empty i) (mk_v I ?ODE (sol 0, b) x))}"
      and notin:" ¬(Predicates I vid1 (χ i. dterm_sem I (empty i) (sol 0, b)))"
    have fsafe:"fsafe (Prop vid1 empty)" by (auto simp add: empty_def)
    from sol have "Predicates I vid1 (χ i. dterm_sem I (empty i) (?φ 0))"
      using t solves_ode_domainD[of sol "(λa. ODEs I vid1)" "{0..t}"]  by auto
    then have incon:"Predicates I vid1 (χ i. dterm_sem I (empty i) ((sol 0, b)))"
      using coincidence_formula[OF fsafe Iagree_refl[of I], of "(sol 0, b)" "?φ 0"]
      unfolding Vagree_def by (auto simp add: empty_def)
    show "dterm_sem I (f1 fid2 vid1)  (mk_v I (OVar vid1) (sol 0, b) (sol t)) ≤ dterm_sem I (f1 fid1 vid1) (mk_v I (OVar vid1) (sol 0, b) (sol t))"
      using notin incon by auto
  next
    fix I::"('sf,'sc,'sz) interp" and  b aa ba 
      and sol::"real ⇒ 'sz simple_state" 
      and t::real
    let ?ODE = "OVar vid1"
    let ?φ = "(λt. mk_v I (?ODE) (sol 0, b) (sol t))"
    assume t:"0 ≤ t"
    assume sol:"(sol solves_ode (λa. ODEs I vid1)) {0..t}
        {x. Predicates I vid1 (χ i. dterm_sem I (local.empty i) (mk_v I (OVar vid1) (sol 0, b) x))}"
    assume notin:"¬ Predicates I vid1 (χ i. dterm_sem I (local.empty i) (sol 0, b))"
    have fsafe:"fsafe (Prop vid1 empty)" by (auto simp add: empty_def)
    from sol have "Predicates I vid1 (χ i. dterm_sem I (empty i) (?φ 0))"
      using t solves_ode_domainD[of sol "(λa. ODEs I vid1)" "{0..t}"]  by auto
    then have incon:"Predicates I vid1 (χ i. dterm_sem I (empty i) ((sol 0, b)))"
      using coincidence_formula[OF fsafe Iagree_refl[of I], of "(sol 0, b)" "?φ 0"]
      unfolding Vagree_def by (auto simp add: empty_def)
    show "dterm_sem I (f1 fid2 vid1) (mk_v I (OVar vid1) (sol 0, b) (sol t))
       ≤ dterm_sem I (f1 fid1 vid1) (mk_v I (OVar vid1) (sol 0, b) (sol t))"
      using incon notin by auto
next
    fix I::"('sf,'sc,'sz) interp" and  b aa ba 
      and sol::"real ⇒ 'sz simple_state" 
      and t::real
    let ?ODE = "OVar vid1"
    let ?φ = "(λt. mk_v I (?ODE) (sol 0, b) (sol t))"
    assume good_interp:"is_interp I"
    assume aaba:"(aa, ba) = mk_v I (OVar vid1) (sol 0, b) (sol t)"
    assume t:"0 ≤ t"
    assume sol:"(sol solves_ode (λa. ODEs I vid1)) {0..t}
        {x. Predicates I vid1 (χ i. dterm_sem I (local.empty i) (mk_v I (OVar vid1) (sol 0, b) x))}"
    assume box:"∀a ba. (∃sola. sol 0 = sola 0 ∧
                      (∃t. (a, ba) = mk_v I (OVar vid1) (sola 0, b) (sola t) ∧
                           0 ≤ t ∧
                           (sola solves_ode (λa. ODEs I vid1)) {0..t}
                            {x. Predicates I vid1
                                 (χ i. dterm_sem I (local.empty i) (mk_v I (OVar vid1) (sola 0, b) x))})) ⟶
              directional_derivative I (f1 fid2 vid1) (a, ba) ≤ directional_derivative I (f1 fid1 vid1) (a, ba)"
    assume geq0:"dterm_sem I (f1 fid2 vid1) (sol 0, b) ≤ dterm_sem I (f1 fid1 vid1) (sol 0, b)"
    have free1:"dfree ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0))"
      by (auto intro: dfree.intros)
    have free2:"dfree ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))"
      by (auto intro: dfree.intros)
    from geq0 
    have geq0':"sterm_sem I (f1 fid2 vid1) (sol 0) ≤ sterm_sem I (f1 fid1 vid1) (sol 0)"
      unfolding f1_def using dterm_sterm_dfree[OF free1, of I "sol 0" b] dterm_sterm_dfree[OF free2, of I "sol 0" b] 
      by auto  
    let ?φs = "λx. fst (?φ x)"
    let ?φt = "λx. snd (?φ x)"
    let ?df1 = "(λt. dterm_sem I (f1 fid2 vid1) (?φ t))"
    let ?f1 = "(λt. sterm_sem I (f1 fid2 vid1) (?φs t))"
    let ?f1' = "(λ s t'. t' * frechet I (f1 fid2 vid1) (?φs s) (?φt s))"
    have dfeq:"?df1 = ?f1" 
      apply(rule ext)
      subgoal for t
        using dterm_sterm_dfree[OF free1, of I "?φs t" "snd (?φ t)"] unfolding f1_def expand_singleton by auto
      done
    have free3:"dfree (f1 fid2 vid1)" unfolding f1_def by (auto intro: dfree.intros)
    let ?df2 = "(λt. dterm_sem I (f1 fid1 vid1) (?φ t))"
    let ?f2 = "(λt. sterm_sem I (f1 fid1 vid1) (?φs t))"
    let ?f2' = "(λs t' . t' * frechet I (f1 fid1 vid1) (?φs s) (?φt s))"
    let ?int = "{0..t}"
    have bluh:"⋀x i. (Functions I i has_derivative (THE f'. ∀x. (Functions I i has_derivative f' x) (at x)) x) (at x)"
      using good_interp unfolding is_interp_def by auto
    have blah:"(Functions I fid2 has_derivative (THE f'. ∀x. (Functions I fid2 has_derivative f' x) (at x)) (χ i. if i = vid1 then sol t $ vid1 else 0)) (at (χ i. if i = vid1 then sol t $ vid1 else 0))"
      using bluh by auto
    have bigEx:"⋀s. s ∈ {0..t} ⟹(∃sola. sol 0 = sola 0 ∧
         (∃ta. (fst (?φ s),
                snd (?φ s)) =
               mk_v I (OVar vid1) (sola 0, b) (sola ta) ∧
               0 ≤ ta ∧
               (sola solves_ode (λa. ODEs I vid1)) {0..ta}
                {x. Predicates I vid1 (χ i. dterm_sem I (local.empty i) (mk_v I (OVar vid1) (sol 0, b) x))}))"
      subgoal for s
        apply(rule exI[where x=sol])
        apply(rule conjI)
         subgoal by (rule refl)
        apply(rule exI[where x=s])
        apply(rule conjI)
         subgoal by auto 
        apply(rule conjI)
         subgoal by auto
        using sol
        using atLeastAtMost_iff atLeastatMost_subset_iff order_refl solves_ode_on_subset
        by (metis (no_types, lifting) subsetI)
      done
    have box':"⋀s. s ∈ {0..t} ⟹ directional_derivative I (f1 fid2 vid1) (?φs s, ?φt s) 
                                ≤ directional_derivative I (f1 fid1 vid1) (?φs s, ?φt s)"
      subgoal for s
      using box 
      apply simp
      apply (erule allE[where x="?φs s"])
      apply (erule allE[where x="?φt s"])
      using bigEx[of s] by auto 
    done
    have dsafe1:"dsafe (f1 fid2 vid1)" unfolding f1_def by (auto intro: dsafe.intros)
    have dsafe2:"dsafe (f1 fid1 vid1)" unfolding f1_def by (auto intro: dsafe.intros)
    have agree1:"Vagree (sol 0, b) (?φ 0) (FVT (f1 fid2 vid1))"
      using mk_v_agree[of I "(OVar vid1)" "(sol 0, b)" "fst (?φ 0)"]
      unfolding f1_def Vagree_def expand_singleton 
      apply auto
      by (metis (no_types, lifting) Compl_iff Vagree_def fst_conv mk_v_agree mk_xode.simps semBV.simps)
    have agree2:"Vagree (sol 0, b) (?φ 0) (FVT (f1 fid1 vid1))"
      using mk_v_agree[of I "(OVar vid1)" "(sol 0, b)" "fst (?φ 0)"]
      unfolding f1_def Vagree_def expand_singleton 
      apply auto
      by (metis (no_types, lifting) Compl_iff Vagree_def fst_conv mk_v_agree mk_xode.simps semBV.simps)
    have sem_eq1:"dterm_sem I (f1 fid2 vid1) (sol 0, b) = dterm_sem I (f1 fid2 vid1) (?φ 0)"
      using coincidence_dterm[OF dsafe1 agree1] by auto
    then have sem_eq1':"sterm_sem I (f1 fid2 vid1) (sol 0) = sterm_sem I (f1 fid2 vid1) (?φs 0)"
      using dterm_sterm_dfree[OF free1, of I "sol 0" "b"] 
            dterm_sterm_dfree[OF free1, of I "(?φs 0)" "snd (?φ 0)"]
      unfolding f1_def expand_singleton by auto
    have sem_eq2:"dterm_sem I (f1 fid1 vid1) (sol 0, b) = dterm_sem I (f1 fid1 vid1) (?φ 0)"
      using coincidence_dterm[OF dsafe2 agree2] by auto
    then have sem_eq2':"sterm_sem I (f1 fid1 vid1) (sol 0) = sterm_sem I (f1 fid1 vid1) (?φs 0)" 
      using dterm_sterm_dfree[OF free2, of I "sol 0" "b"] dterm_sterm_dfree[OF free2, of I "(?φs 0)" "snd (?φ 0)"]
      unfolding f1_def expand_singleton by auto
    have good_interp':"⋀i x. (Functions I i has_derivative (THE f'. ∀x. (Functions I i has_derivative f' x) (at x)) x) (at x)"
      using good_interp unfolding is_interp_def by auto
    have chain :  
      "⋀f f' g g' x s.
        (f has_derivative f') (at x within s) ⟹
        (g has_derivative g') (at (f x) within f ` s) ⟹ (g ∘ f has_derivative g' ∘ f') (at x within s)"
      by(auto intro: derivative_intros)
    have sol1:"(sol solves_ode (λ_. ODE_sem I (OVar vid1))) {0..t} {x. mk_v I (OVar vid1) (sol 0, b) x ∈ fml_sem I (Prop vid1 empty)}"
      using sol unfolding p1_def singleton_def empty_def by auto
    have FVTsub1:"vid1 ∈ ODE_vars I (OVar vid1) ⟹ FVT ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) ⊆ semBV I ((OVar vid1))"
      apply auto
      subgoal for x xa
        apply(cases "xa = vid1")
         by auto
      done
    have FVTsub2:"vid1 ∈ ODE_vars I (OVar vid1) ⟹ FVT ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)) ⊆ semBV I ((OVar vid1))"
      apply auto
      subgoal for x xa
        apply(cases "xa = vid1")
         by auto
      done
    have osafe:"osafe (OVar vid1)"
      by auto
    have deriv1:"⋀s. vid1 ∈ ODE_vars I (OVar vid1) ⟹ s ∈ ?int ⟹ (?f1 has_derivative (?f1' s)) (at s within {0..t})"
      subgoal for s
        using  rift_in_space_time[OF good_interp free1 osafe sol1 FVTsub1, of s]
        unfolding f1_def expand_singleton directional_derivative_def
        by blast
      done
    have deriv2:"⋀s. vid1 ∈ ODE_vars I (OVar vid1) ⟹ s ∈ ?int ⟹ (?f2 has_derivative (?f2' s)) (at s within {0..t})"
      subgoal for s
        using rift_in_space_time[OF good_interp free2 osafe sol1 FVTsub2, of s] 
        unfolding f1_def expand_singleton directional_derivative_def
        by blast
      done
    have leq:"⋀s . s ∈ ?int ⟹ ?f1' s 1 ≤ ?f2' s 1"
      subgoal for s using box'[of s] 
        by (simp add: directional_derivative_def)
      done
    have preserve_agree1:"vid1 ∉ ODE_vars I (OVar vid1) ⟹ VSagree (sol 0) (fst (mk_v I (OVar vid1) (sol 0, b) (sol t))) {vid1}"
      using mk_v_agree[of I "OVar vid1" "(sol 0, b)" "sol t"]
      unfolding Vagree_def VSagree_def
      by auto
    have preserve_coincide1:
      "vid1 ∉ ODE_vars I (OVar vid1) ⟹ 
      sterm_sem I (f1 fid2 vid1) (fst (mk_v I (OVar vid1) (sol 0, b) (sol t)))
     = sterm_sem I (f1 fid2 vid1) (sol 0)" 
      using coincidence_sterm[of "(sol 0, b)" "(mk_v I (OVar vid1) (sol 0, b) (sol t))" "f1 fid2 vid1" I]
      preserve_agree1 unfolding VSagree_def Vagree_def f1_def by auto
    have preserve_coincide2:
      "vid1 ∉ ODE_vars I (OVar vid1) ⟹ 
      sterm_sem I (f1 fid1 vid1) (fst (mk_v I (OVar vid1) (sol 0, b) (sol t)))
     = sterm_sem I (f1 fid1 vid1) (sol 0)" 
      using coincidence_sterm[of "(sol 0, b)" "(mk_v I (OVar vid1) (sol 0, b) (sol t))" "f1 fid1 vid1" I]
      preserve_agree1 unfolding VSagree_def Vagree_def f1_def by auto
    have "?f1 t ≤ ?f2 t"
      apply(cases "t = 0")
       subgoal using geq0' sem_eq1' sem_eq2' by auto  
      subgoal
        apply(cases "vid1 ∈ ODE_vars I (OVar vid1)")
        subgoal
          apply (rule MVT'[OF deriv2 deriv1, of t]) (* 8 subgoals *)
                 subgoal by auto
                subgoal by auto
               subgoal for s using deriv2[of s] using leq by auto
              using t leq geq0' sem_eq1' sem_eq2' by auto
        subgoal
          using geq0 
          using dterm_sterm_dfree[OF free1, of I "sol 0" "b"]
          using dterm_sterm_dfree[OF free2, of I "sol 0" "b"]
          using preserve_coincide1 preserve_coincide2
          by(simp add: f1_def)
        done
      done
    then 
    show "       dterm_sem I (f1 fid2 vid1) (mk_v I (OVar vid1) (sol 0, b) (sol t))
       ≤ dterm_sem I (f1 fid1 vid1) (mk_v I (OVar vid1) (sol 0, b) (sol t))
"
      using t 
      dterm_sterm_dfree[OF free2, of I "?φs t" "snd (?φ t)"]
      dterm_sterm_dfree[OF free1, of I "?φs t" "snd (?φ t)"]
      by (simp add: f1_def)
qed 
  
  
lemma DIGr_valid:"valid DIGraxiom"
  unfolding DIGraxiom_def
  apply(unfold DIGraxiom_def valid_def impl_sem iff_sem)
  apply(auto) (* 4 subgoals*)
proof -
  fix I::"('sf,'sc,'sz) interp" and  b aa ba 
    and sol::"real ⇒ 'sz simple_state" 
    and t::real
  let ?ODE = "OVar vid1"
  let ?φ = "(λt. mk_v I (?ODE) (sol 0, b) (sol t))"
  assume t:"0 ≤ t"
    and sol:"(sol solves_ode (λa. ODEs I vid1)) {0..t}
    {x. Predicates I vid1 (χ i. dterm_sem I (empty i) (mk_v I ?ODE (sol 0, b) x))}"
    and notin:" ¬(Predicates I vid1 (χ i. dterm_sem I (empty i) (sol 0, b)))"
  have fsafe:"fsafe (Prop vid1 empty)" by (auto simp add: empty_def)
  from sol have "Predicates I vid1 (χ i. dterm_sem I (empty i) (?φ 0))"
    using t solves_ode_domainD[of sol "(λa. ODEs I vid1)" "{0..t}"]  by auto
  then have incon:"Predicates I vid1 (χ i. dterm_sem I (empty i) ((sol 0, b)))"
    using coincidence_formula[OF fsafe Iagree_refl[of I], of "(sol 0, b)" "?φ 0"]
    unfolding Vagree_def by (auto simp add: empty_def)
  show "dterm_sem I (f1 fid2 vid1)  (mk_v I (OVar vid1) (sol 0, b) (sol t)) < dterm_sem I (f1 fid1 vid1) (mk_v I (OVar vid1) (sol 0, b) (sol t))"
    using notin incon by auto
next
  fix I::"('sf,'sc,'sz) interp" and  b aa ba 
    and sol::"real ⇒ 'sz simple_state" 
    and t::real
  let ?ODE = "OVar vid1"
  let ?φ = "(λt. mk_v I (?ODE) (sol 0, b) (sol t))"
  assume t:"0 ≤ t"
    and sol:"(sol solves_ode (λa. ODEs I vid1)) {0..t}
    {x. Predicates I vid1 (χ i. dterm_sem I (empty i) (mk_v I ?ODE (sol 0, b) x))}"
    and notin:" ¬(Predicates I vid1 (χ i. dterm_sem I (empty i) (sol 0, b)))"
  have fsafe:"fsafe (Prop vid1 empty)" by (auto simp add: empty_def)
  from sol have "Predicates I vid1 (χ i. dterm_sem I (empty i) (?φ 0))"
    using t solves_ode_domainD[of sol "(λa. ODEs I vid1)" "{0..t}"]  by auto
  then have incon:"Predicates I vid1 (χ i. dterm_sem I (empty i) ((sol 0, b)))"
    using coincidence_formula[OF fsafe Iagree_refl[of I], of "(sol 0, b)" "?φ 0"]
    unfolding Vagree_def by (auto simp add: empty_def)
  show "dterm_sem I (f1 fid2 vid1)  (mk_v I (OVar vid1) (sol 0, b) (sol t)) < dterm_sem I (f1 fid1 vid1) (mk_v I (OVar vid1) (sol 0, b) (sol t))"
    using notin incon by auto
next
  fix I::"('sf,'sc,'sz) interp" and  b aa ba 
    and sol::"real ⇒ 'sz simple_state" 
    and t::real
  let ?ODE = "OVar vid1"
  let ?φ = "(λt. mk_v I (?ODE) (sol 0, b) (sol t))"
  assume t:"0 ≤ t"
  assume sol:"(sol solves_ode (λa. ODEs I vid1)) {0..t}
      {x. Predicates I vid1 (χ i. dterm_sem I (local.empty i) (mk_v I (OVar vid1) (sol 0, b) x))}"
  assume notin:"¬ Predicates I vid1 (χ i. dterm_sem I (local.empty i) (sol 0, b))"
  have fsafe:"fsafe (Prop vid1 empty)" by (auto simp add: empty_def)
  from sol have "Predicates I vid1 (χ i. dterm_sem I (empty i) (?φ 0))"
    using t solves_ode_domainD[of sol "(λa. ODEs I vid1)" "{0..t}"]  by auto
  then have incon:"Predicates I vid1 (χ i. dterm_sem I (empty i) ((sol 0, b)))"
    using coincidence_formula[OF fsafe Iagree_refl[of I], of "(sol 0, b)" "?φ 0"]
    unfolding Vagree_def by (auto simp add: empty_def) 
  show "dterm_sem I (f1 fid2 vid1) (mk_v I (OVar vid1) (sol 0, b) (sol t))
     < dterm_sem I (f1 fid1 vid1) (mk_v I (OVar vid1) (sol 0, b) (sol t))"
    using incon notin by auto
next
  fix I::"('sf,'sc,'sz) interp" and  b aa ba 
  and sol::"real ⇒ 'sz simple_state" 
  and t::real
  let ?ODE = "OVar vid1"
  let ?φ = "(λt. mk_v I (?ODE) (sol 0, b) (sol t))"
  assume good_interp:"is_interp I"
  assume aaba:"(aa, ba) = mk_v I (OVar vid1) (sol 0, b) (sol t)"
  assume t:"0 ≤ t"
  assume sol:"(sol solves_ode (λa. ODEs I vid1)) {0..t}
      {x. Predicates I vid1 (χ i. dterm_sem I (local.empty i) (mk_v I (OVar vid1) (sol 0, b) x))}"
  assume box:"∀a ba. (∃sola. sol 0 = sola 0 ∧
                    (∃t. (a, ba) = mk_v I (OVar vid1) (sola 0, b) (sola t) ∧
                         0 ≤ t ∧
                         (sola solves_ode (λa. ODEs I vid1)) {0..t}
                          {x. Predicates I vid1
                               (χ i. dterm_sem I (local.empty i) (mk_v I (OVar vid1) (sola 0, b) x))})) ⟶
            directional_derivative I (f1 fid2 vid1) (a, ba) ≤ directional_derivative I (f1 fid1 vid1) (a, ba)"
  assume geq0:"dterm_sem I (f1 fid2 vid1) (sol 0, b) < dterm_sem I (f1 fid1 vid1) (sol 0, b)"
  have free1:"dfree ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0))"
    by (auto intro: dfree.intros)
  have free2:"dfree ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))"
    by (auto intro: dfree.intros)
  from geq0 
  have geq0':"sterm_sem I (f1 fid2 vid1) (sol 0) < sterm_sem I (f1 fid1 vid1) (sol 0)"
    unfolding f1_def using dterm_sterm_dfree[OF free1, of I "sol 0" b] dterm_sterm_dfree[OF free2, of I "sol 0" b] 
    by auto  
  let ?φs = "λx. fst (?φ x)"
  let ?φt = "λx. snd (?φ x)"
  let ?df1 = "(λt. dterm_sem I (f1 fid2 vid1) (?φ t))"
  let ?f1 = "(λt. sterm_sem I (f1 fid2 vid1) (?φs t))"
  let ?f1' = "(λ s t'. t' * frechet I (f1 fid2 vid1) (?φs s) (?φt s))"
  have dfeq:"?df1 = ?f1" 
    apply(rule ext)
    subgoal for t
      using dterm_sterm_dfree[OF free1, of I "?φs t" "snd (?φ t)"] unfolding f1_def expand_singleton by auto
    done
  have free3:"dfree (f1 fid2 vid1)" unfolding f1_def by (auto intro: dfree.intros)
  let ?df2 = "(λt. dterm_sem I (f1 fid1 vid1) (?φ t))"
  let ?f2 = "(λt. sterm_sem I (f1 fid1 vid1) (?φs t))"
  let ?f2' = "(λs t' . t' * frechet I (f1 fid1 vid1) (?φs s) (?φt s))"
  let ?int = "{0..t}"
  have bluh:"⋀x i. (Functions I i has_derivative (THE f'. ∀x. (Functions I i has_derivative f' x) (at x)) x) (at x)"
    using good_interp unfolding is_interp_def by auto
  have blah:"(Functions I fid2 has_derivative (THE f'. ∀x. (Functions I fid2 has_derivative f' x) (at x)) (χ i. if i = vid1 then sol t $ vid1 else 0)) (at (χ i. if i = vid1 then sol t $ vid1 else 0))"
    using bluh by auto
  have bigEx:"⋀s. s ∈ {0..t} ⟹(∃sola. sol 0 = sola 0 ∧
       (∃ta. (fst (?φ s),
              snd (?φ s)) =
             mk_v I (OVar vid1) (sola 0, b) (sola ta) ∧
             0 ≤ ta ∧
             (sola solves_ode (λa. ODEs I vid1)) {0..ta}
              {x. Predicates I vid1 (χ i. dterm_sem I (local.empty i) (mk_v I (OVar vid1) (sol 0, b) x))}))"
    subgoal for s
      apply(rule exI[where x=sol])
      apply(rule conjI)
       subgoal by (rule refl)
      apply(rule exI[where x=s])
      apply(rule conjI)
       subgoal by auto 
      apply(rule conjI)
       subgoal by auto
      using sol
      using atLeastAtMost_iff atLeastatMost_subset_iff order_refl solves_ode_on_subset
      by (metis (no_types, lifting) subsetI)
    done
  have box':"⋀s. s ∈ {0..t} ⟹ directional_derivative I (f1 fid2 vid1) (?φs s, ?φt s) 
                              ≤ directional_derivative I (f1 fid1 vid1) (?φs s, ?φt s)"
    subgoal for s
    using box 
    apply simp
    apply (erule allE[where x="?φs s"])
    apply (erule allE[where x="?φt s"])
    using bigEx[of s] by auto 
  done
  have dsafe1:"dsafe (f1 fid2 vid1)" unfolding f1_def by (auto intro: dsafe.intros)
  have dsafe2:"dsafe (f1 fid1 vid1)" unfolding f1_def by (auto intro: dsafe.intros)
  have agree1:"Vagree (sol 0, b) (?φ 0) (FVT (f1 fid2 vid1))"
    using mk_v_agree[of I "(OVar vid1)" "(sol 0, b)" "fst (?φ 0)"]
    unfolding f1_def Vagree_def expand_singleton 
    apply auto
    by (metis (no_types, lifting) Compl_iff Vagree_def fst_conv mk_v_agree mk_xode.simps semBV.simps)
  have agree2:"Vagree (sol 0, b) (?φ 0) (FVT (f1 fid1 vid1))"
    using mk_v_agree[of I "(OVar vid1)" "(sol 0, b)" "fst (?φ 0)"]
    unfolding f1_def Vagree_def expand_singleton 
    apply auto
    by (metis (no_types, lifting) Compl_iff Vagree_def fst_conv mk_v_agree mk_xode.simps semBV.simps)
  have sem_eq1:"dterm_sem I (f1 fid2 vid1) (sol 0, b) = dterm_sem I (f1 fid2 vid1) (?φ 0)"
    using coincidence_dterm[OF dsafe1 agree1] by auto
  then have sem_eq1':"sterm_sem I (f1 fid2 vid1) (sol 0) = sterm_sem I (f1 fid2 vid1) (?φs 0)"
    using dterm_sterm_dfree[OF free1, of I "sol 0" "b"] 
          dterm_sterm_dfree[OF free1, of I "(?φs 0)" "snd (?φ 0)"]
    unfolding f1_def expand_singleton by auto
  have sem_eq2:"dterm_sem I (f1 fid1 vid1) (sol 0, b) = dterm_sem I (f1 fid1 vid1) (?φ 0)"
    using coincidence_dterm[OF dsafe2 agree2] by auto
  then have sem_eq2':"sterm_sem I (f1 fid1 vid1) (sol 0) = sterm_sem I (f1 fid1 vid1) (?φs 0)" 
    using dterm_sterm_dfree[OF free2, of I "sol 0" "b"] dterm_sterm_dfree[OF free2, of I "(?φs 0)" "snd (?φ 0)"]
    unfolding f1_def expand_singleton by auto
  have good_interp':"⋀i x. (Functions I i has_derivative (THE f'. ∀x. (Functions I i has_derivative f' x) (at x)) x) (at x)"
    using good_interp unfolding is_interp_def by auto
  have chain :  
    "⋀f f' g g' x s.
      (f has_derivative f') (at x within s) ⟹
      (g has_derivative g') (at (f x) within f ` s) ⟹ (g ∘ f has_derivative g' ∘ f') (at x within s)"
    by(auto intro: derivative_intros)
  have sol1:"(sol solves_ode (λ_. ODE_sem I (OVar vid1))) {0..t} {x. mk_v I (OVar vid1) (sol 0, b) x ∈ fml_sem I (Prop vid1 empty)}"
    using sol unfolding p1_def singleton_def empty_def by auto
  have FVTsub1:"vid1 ∈ ODE_vars I (OVar vid1) ⟹ FVT ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) ⊆ semBV I ((OVar vid1))"
    apply auto
    subgoal for x xa
      apply(cases "xa = vid1")
       by auto
    done
  have FVTsub2:"vid1 ∈ ODE_vars I (OVar vid1) ⟹ FVT ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)) ⊆ semBV I ((OVar vid1))"
    apply auto
    subgoal for x xa
      apply(cases "xa = vid1")
       by auto
    done
  have osafe:"osafe (OVar vid1)"
    by auto
  have deriv1:"⋀s. vid1 ∈ ODE_vars I (OVar vid1) ⟹ s ∈ ?int ⟹ (?f1 has_derivative (?f1' s)) (at s within {0..t})"
    subgoal for s
      using  rift_in_space_time[OF good_interp free1 osafe sol1 FVTsub1, of s]
      unfolding f1_def expand_singleton directional_derivative_def
      by blast
    done
  have deriv2:"⋀s. vid1 ∈ ODE_vars I (OVar vid1) ⟹ s ∈ ?int ⟹ (?f2 has_derivative (?f2' s)) (at s within {0..t})"
    subgoal for s
      using rift_in_space_time[OF good_interp free2 osafe sol1 FVTsub2, of s] 
      unfolding f1_def expand_singleton directional_derivative_def
      by blast
    done
  have leq:"⋀s . s ∈ ?int ⟹ ?f1' s 1 ≤ ?f2' s 1"
    subgoal for s using box'[of s] 
      by (simp add: directional_derivative_def)
    done
  have preserve_agree1:"vid1 ∉ ODE_vars I (OVar vid1) ⟹ VSagree (sol 0) (fst (mk_v I (OVar vid1) (sol 0, b) (sol t))) {vid1}"
    using mk_v_agree[of I "OVar vid1" "(sol 0, b)" "sol t"]
    unfolding Vagree_def VSagree_def
    by auto
  have preserve_coincide1:
    "vid1 ∉ ODE_vars I (OVar vid1) ⟹ 
    sterm_sem I (f1 fid2 vid1) (fst (mk_v I (OVar vid1) (sol 0, b) (sol t)))
   = sterm_sem I (f1 fid2 vid1) (sol 0)" 
    using coincidence_sterm[of "(sol 0, b)" "(mk_v I (OVar vid1) (sol 0, b) (sol t))" "f1 fid2 vid1" I]
    preserve_agree1 unfolding VSagree_def Vagree_def f1_def by auto
  have preserve_coincide2:
    "vid1 ∉ ODE_vars I (OVar vid1) ⟹ 
    sterm_sem I (f1 fid1 vid1) (fst (mk_v I (OVar vid1) (sol 0, b) (sol t)))
   = sterm_sem I (f1 fid1 vid1) (sol 0)" 
    using coincidence_sterm[of "(sol 0, b)" "(mk_v I (OVar vid1) (sol 0, b) (sol t))" "f1 fid1 vid1" I]
    preserve_agree1 unfolding VSagree_def Vagree_def f1_def by auto
  have "?f1 t < ?f2 t"
    apply(cases "t = 0")
     subgoal using geq0' sem_eq1' sem_eq2' by auto  
    subgoal
      apply(cases "vid1 ∈ ODE_vars I (OVar vid1)")
      subgoal
        apply (rule MVT'_gr[OF deriv2 deriv1, of t])
               subgoal by auto
              subgoal by auto
             subgoal for s using deriv2[of s] using leq by auto
            using t leq geq0' sem_eq1' sem_eq2' by auto
      subgoal
        using geq0 
        using dterm_sterm_dfree[OF free1, of I "sol 0" "b"]
        using dterm_sterm_dfree[OF free2, of I "sol 0" "b"]
        using preserve_coincide1 preserve_coincide2
        by(simp add: f1_def)
      done
    done
  then 
  show "dterm_sem I (f1 fid2 vid1) (mk_v I (OVar vid1) (sol 0, b) (sol t))
     < dterm_sem I (f1 fid1 vid1) (mk_v I (OVar vid1) (sol 0, b) (sol t))"
    using t 
    dterm_sterm_dfree[OF free2, of I "?φs t" "snd (?φ t)"]
    dterm_sterm_dfree[OF free1, of I "?φs t" "snd (?φ t)"]
    using geq0 f1_def
    by (simp add: f1_def)
qed 

lemma DG_valid:"valid DGaxiom"
proof -
  have osafe:"osafe (OSing vid1 (f1 fid1 vid1))" 
    by(auto simp add: osafe_Sing dfree_Fun dfree_Const f1_def expand_singleton)
  have fsafe:"fsafe (p1 vid1 vid1)" 
    by(auto simp add: p1_def dfree_Const)
  have osafe2:"osafe (OProd (OSing vid1 (f1 fid1 vid1)) (OSing vid2 (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1))))"
    by(auto simp add: f1_def expand_singleton osafe.intros dfree.intros vne12)
  note sem = ode_alt_sem[OF osafe fsafe]
  note sem2 = ode_alt_sem[OF osafe2 fsafe]
  have p2safe:"fsafe (p1 vid2 vid1)" by(auto simp add: p1_def dfree_Const)
  show "valid DGaxiom"
    apply(auto simp  del: prog_sem.simps(8) simp add: DGaxiom_def valid_def sem sem2)
     apply(rule exI[where x=0], auto simp add: f1_def p1_def expand_singleton)
     subgoal for I a b aa ba sol t
     proof -
       assume good_interp:"is_interp I"
       assume "
∀aa ba. (∃sol t. (aa, ba) = mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (sol t) ∧
                      0 ≤ t ∧
                      (sol solves_ode (λa b. χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0)) {0..t}
                       {x. Predicates I vid1
                            (χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                                   (mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) x))} ∧
                      VSagree (sol 0) a {uu. uu = vid1 ∨
                            Inl uu ∈ Inl ` {x. ∃xa. Inl x ∈ FVT (if xa = vid1 then trm.Var vid1 else Const 0)} ∨
                            (∃x. Inl uu ∈ FVT (if x = vid1 then trm.Var vid1 else Const 0))}) ⟶
             Predicates I vid2 (χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (aa, ba))"
       then have 
         bigAll:"
⋀aa ba. (∃sol t. (aa, ba) = mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (sol t) ∧
                      0 ≤ t ∧
                      (sol solves_ode (λa b. χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0)) {0..t}
                       {x. Predicates I vid1
                            (χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                                   (mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) x))} ∧
                      VSagree (sol 0) a {uu. uu = vid1 ∨ (∃x. Inl uu ∈ FVT (if x = vid1 then trm.Var vid1 else Const 0))}) ⟶
             Predicates I vid2 (χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (aa, ba))"
         by (auto)
       assume aaba:"(aa, ba) =
  mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
           (OSing vid2
             (Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
               ($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))
   (χ y. if vid2 = y then 0 else fst (a, b) $ y, b) (sol t)"
       assume t:"0 ≤ t"
       assume sol:"
     (sol solves_ode
   (λa b. (χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0) +
          (χ i. if i = vid2 then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1)) b else 0)))
   {0..t} {x. Predicates I vid1
               (χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                      (mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
                                (OSing vid2
                                  (Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                                    ($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))
                        (χ y. if vid2 = y then 0 else fst (a, b) $ y, b) x))}"
     assume VSag:"VSagree (sol 0) (χ y. if vid2 = y then 0 else fst (a, b) $ y)
     {x. x = vid2 ∨ x = vid1 ∨ x = vid2 ∨ x = vid1 ∨ Inl x ∈ Inl ` {x. x = vid2 ∨ x = vid1} ∨ x = vid1}"
       let ?sol = "(λt. χ i. if i = vid1 then sol t $ vid1 else 0)"
       let ?aaba' = "mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (?sol t)"
     from bigAll[of "fst ?aaba'" "snd ?aaba'"] 
     have bigEx:"(∃sol t. ?aaba' = mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (sol t) ∧
                        0 ≤ t ∧
                        (sol solves_ode (λa b. χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0)) {0..t}
                         {x. Predicates I vid1
                              (χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                                     (mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) x))} ∧
                        VSagree (sol 0) a {uu. uu = vid1 ∨ (∃x. Inl uu ∈ FVT (if x = vid1 then trm.Var vid1 else Const 0))}) ⟶
               Predicates I vid2 (χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (?aaba'))" 
       by simp
     have pre1:"?aaba' = mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (?sol t)" 
       by (rule refl)
     have agreeL:"⋀s. fst (mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
                   (OSing vid2
                     (Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                       ($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))
           (χ y. if vid2 = y then 0 else fst (a, b) $ y, b) (sol s)) $ vid1 = sol s $ vid1"
       subgoal for s
         using mk_v_agree[of I "(OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
                   (OSing vid2
                      (Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                        ($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))" "(χ y. if vid2 = y then 0 else fst (a, b) $ y, b)" "(sol s)"]
         unfolding Vagree_def by auto done
       have agreeR:"⋀s. fst (mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (χ i. if i = vid1 then sol s $ vid1 else 0)) $ vid1 = sol s $ vid1" 
         subgoal for s
           using mk_v_agree[of "I" "(OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))" "(a, b)" "(χ i. if i = vid1 then sol s $ vid1 else 0)"]
           unfolding Vagree_def by auto
         done
       have FV:"(FVF (p1 vid1 vid1)) = {Inl vid1}" unfolding p1_def expand_singleton
         apply auto subgoal for x xa apply(cases "xa = vid1") by auto done
       have agree:"⋀s. Vagree (mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
                     (OSing vid2
                       (Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                         ($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))
             (χ y. if vid2 = y then 0 else fst (a, b) $ y, b) (sol s)) (mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (χ i. if i = vid1 then sol s $ vid1 else 0)) (FVF (p1 vid1 vid1))"
         using agreeR agreeL unfolding Vagree_def FV by auto
       note con_sem_eq = coincidence_formula[OF fsafe Iagree_refl agree]
       have constraint:"⋀s. 0 ≤ s ∧ s ≤ t ⟹
         Predicates I vid1
         (χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
               (mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (χ i. if i = vid1 then sol s $ vid1 else 0)))"
         using sol apply simp
         apply(drule solves_odeD(2))
          apply auto[1]
         subgoal for s using con_sem_eq by (auto simp add: p1_def expand_singleton)
         done
       have eta:"sol = (λt. χ i. sol t $ i)" by (rule ext, rule vec_extensionality, simp)
       have yet_another_eq:"⋀x. (λxa. xa *⇩_R ((χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (sol x) else 0) +
                          (χ i. if i = vid2 then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1)) (sol x) else 0)))
 = (λxa. (χ i. (xa *⇩_R ((χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (sol x) else 0) +
                          (χ i. if i = vid2 then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1)) (sol x) else 0))) $ i))"
         subgoal for x by (rule ext, rule vec_extensionality, simp) done
       have sol_deriv:"⋀x. x ∈{0..t} ⟹
           (sol has_derivative
            (λxa. xa *⇩_R ((χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (sol x) else 0) +
                          (χ i. if i = vid2 then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1)) (sol x) else 0))))
            (at x within {0..t})"
         using sol apply simp
         apply(drule solves_odeD(1))
         unfolding has_vderiv_on_def has_vector_derivative_def by auto
       then have sol_deriv:"⋀x. x ∈ {0..t} ⟹
           ((λt. χ i. sol t $ i) has_derivative
            (λxa. (χ i. (xa *⇩_R ((χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (sol x) else 0) +
                          (χ i. if i = vid2 then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1)) (sol x) else 0))) $ i)))
            (at x within {0..t})" using yet_another_eq eta by auto
       have sol_deriv1: "⋀x. x ∈ {0..t} ⟹
          ((λt. sol t $ vid1) has_derivative
           (λxa. (xa *⇩_R ((χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (sol x) else 0) +
                         (χ i. if i = vid2 then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1)) (sol x) else 0)) $ vid1)))
           (at x within {0..t})"
         subgoal for s
           (* I heard higher-order unification is hard.*)
         apply(rule has_derivative_proj[of "(λ i t. sol t $ i)" "(λj xa. (xa *⇩_R ((χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (sol s) else 0) +
                         (χ i. if i = vid2 then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1)) (sol s) else 0)) $ j))" "at s within {0..t}""vid1"])
         using sol_deriv[of s] by auto done
      have hmm:"⋀s. (χ i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (sol s)) = (χ i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (χ i. if i = vid1 then sol s $ vid1 else 0))"
        by(rule vec_extensionality, auto)
      have aha:"⋀s. (λxa. xa * sterm_sem I (f1 fid1 vid1) (sol s)) = (λxa. xa * sterm_sem I (f1 fid1 vid1) (χ i. if i = vid1 then sol s $ vid1 else 0))"
        subgoal for s
          apply(rule ext)
          subgoal for xa using hmm by (auto simp add: f1_def) done done 
      let ?sol' = "(λs. (λxa. χ i. if i = vid1 then xa * sterm_sem I (f1 fid1 vid1) (χ i. if i = vid1 then sol s $ vid1 else 0) else 0))"
      let ?project_me_plz = "(λt. (χ i. if i = vid1 then ?sol t $ vid1 else 0))"
      have sol_deriv_eq:"⋀s. s ∈{0..t} ⟹
     ((λt. (χ i. if i = vid1 then ?sol t $ vid1 else 0)) has_derivative ?sol' s) (at s within {0..t})"
        subgoal for s
          apply(rule has_derivative_vec)
          subgoal for i
            apply (cases "i = vid1", cases "i = vid2", auto)
             using vne12 apply simp
            using sol_deriv1[of s] using aha by auto
          done done
      have yup:"(λt. (χ i. if i = vid1 then ?sol t $ vid1 else 0) $ vid1) = (λt. sol t $ vid1)"
        by(rule ext, auto)
      have maybe:"⋀s. (λxa. xa * sterm_sem I (f1 fid1 vid1) (χ i. if i = vid1 then sol s $ vid1 else 0)) = (λxa. (χ i. if i = vid1 then xa * sterm_sem I (f1 fid1 vid1) (χ i. if i = vid1 then sol s $ vid1 else 0) else 0) $ vid1) "
        by(rule ext, auto)
      have almost:"(λx. if vid1 = vid1 then (χ i. if i = vid1 then sol x $ vid1 else 0) $ vid1 else 0) =
(λx.  (χ i. if i = vid1 then sol x $ vid1 else 0) $ vid1)" by(rule ext, auto)
      have almost':"⋀s. (λh. if vid1 = vid1 then h * sterm_sem I (f1 fid1 vid1) (χ i. if i = vid1 then sol s $ vid1 else 0) else 0) = (λh. h * sterm_sem I (f1 fid1 vid1) (χ i. if i = vid1 then sol s $ vid1 else 0))"
        by(rule ext, auto)
      have deriv':" ⋀x. x ∈ {0..t} ⟹
     ((λt. χ i. if i = vid1 then sol t $ vid1 else 0) has_derivative
      (λxa. (χ i. xa *⇩_R (if i = vid1 then sterm_sem I (f1 fid1 vid1) (χ i. if i = vid1 then sol x $ vid1 else 0) else 0))))
      (at x within {0..t})"
        subgoal for s
          apply(rule has_derivative_vec)
          subgoal for i
            apply(cases "i = vid1")
             prefer 2 subgoal by auto
            apply auto              
            using has_derivative_proj[OF sol_deriv_eq[of s], of vid1] using  yup maybe[of s] almost almost'[of s] 
            by fastforce
          done 
        done
      have derEq:"⋀s. (λxa. (χ i. xa *⇩_R (if i = vid1 then sterm_sem I (f1 fid1 vid1) (χ i. if i = vid1 then sol s $ vid1 else 0) else 0)))
 = (λxa. xa *⇩_R (χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (χ i. if i = vid1 then sol s $ vid1 else 0) else 0))"
        subgoal for s apply (rule ext, rule vec_extensionality) by auto done
      have "⋀x. x ∈ {0..t} ⟹
     ((λt. χ i. if i = vid1 then sol t $ vid1 else 0) has_derivative
      (λxa. xa *⇩_R (χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (χ i. if i = vid1 then sol x $ vid1 else 0) else 0)))
      (at x within {0..t})" subgoal for s using deriv'[of s] derEq[of s] by auto done
      then have deriv:"((λt. χ i. if i = vid1 then sol t $ vid1 else 0) has_vderiv_on
        (λt. χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (χ i. if i = vid1 then sol t $ vid1 else 0) else 0))
        {0..t}"
        unfolding has_vderiv_on_def has_vector_derivative_def
        by auto 
      have pre2:"(?sol solves_ode (λa b. χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0)) {0..t}
     {x. Predicates I vid1
          (χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                 (mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) x))}"
        apply(rule solves_odeI)
         subgoal by (rule deriv)
        subgoal for s using constraint by auto
        done
      have pre3:"VSagree (?sol 0) a {u. u = vid1 ∨ (∃x. Inl u ∈ FVT (if x = vid1 then trm.Var vid1 else Const 0))}"
        using vne12 VSag unfolding VSagree_def by simp 
      have bigPre:"(∃sol t. ?aaba' = mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then Var vid1 else Const 0))) (a, b) (sol t) ∧
                      0 ≤ t ∧
                      (sol solves_ode (λa b. χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0)) {0..t}
                       {x. Predicates I vid1
                            (χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                                   (mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then Var vid1 else Const 0))) (a, b) x))} ∧
                      VSagree (sol 0) a {u. u = vid1 ∨ (∃x. Inl u ∈ FVT (if x = vid1 then Var vid1 else Const 0))})"
        apply(rule exI[where x="?sol"])
        apply(rule exI[where x=t])
        apply(rule conjI)
         apply(rule pre1)
        apply(rule conjI)
         apply(rule t)
        apply(rule conjI)
         apply(rule pre2)
        by(rule pre3)
      have pred2:"Predicates I vid2 (χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) ?aaba')"
        using bigEx bigPre by auto
      then have pred2':"?aaba' ∈ fml_sem I (p1 vid2 vid1)" unfolding p1_def expand_singleton by auto
      let ?res_state = "(mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
                    (OSing vid2
                      (Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                        ($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))
            (χ y. if vid2 = y then 0 else fst (a, b) $ y, b) (sol t))"
      have aabaX:"(fst ?aaba') $ vid1 = sol t $ vid1" 
        using aaba mk_v_agree[of "I" "(OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))"
 "(a, b)" "(?sol t)"] 
      proof -
        assume " Vagree (mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (χ i. if i = vid1 then sol t $ vid1 else 0))
     (a, b) (- semBV I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))) ∧
   Vagree (mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (χ i. if i = vid1 then sol t $ vid1 else 0))
     (mk_xode I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (χ i. if i = vid1 then sol t $ vid1 else 0))
     (semBV I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))))"
        then have ag:" Vagree (mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (?sol t))
   (mk_xode I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (?sol t))
   (semBV I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))))"
          by auto
        have sembv:"(semBV I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))) = {Inl vid1, Inr vid1}"
          by auto
        have sub:"{Inl vid1} ⊆ {Inl vid1, Inr vid1}" by auto
        have ag':"Vagree (mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (?sol t))
          (mk_xode I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (?sol t)) {Inl vid1}" 
          using ag agree_sub[OF sub] sembv by auto
        then have eq1:"fst (mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (?sol t)) $ vid1 
          = fst (mk_xode I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (?sol t)) $ vid1" unfolding Vagree_def by auto
        moreover have "... = sol t $ vid1" by auto
        ultimately show ?thesis by auto
      qed
      have res_stateX:"(fst ?res_state) $ vid1 = sol t $ vid1" 
        using mk_v_agree[of I "(OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
                    (OSing vid2
                      (Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                        ($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))"
            "(χ y. if vid2 = y then 0 else fst (a, b) $ y, b)" "(sol t)"]
      proof -
        assume "Vagree (mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
                     (OSing vid2
                       (Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                         ($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))
             (χ y. if vid2 = y then 0 else fst (a, b) $ y, b) (sol t))
     (χ y. if vid2 = y then 0 else fst (a, b) $ y, b)
     (- semBV I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
                  (OSing vid2
                    (Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                      ($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))) ∧
    Vagree (mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
                     (OSing vid2
                       (Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                         ($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))
             (χ y. if vid2 = y then 0 else fst (a, b) $ y, b) (sol t))
     (mk_xode I
       (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
         (OSing vid2
           (Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
             ($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))
       (sol t))
     (semBV I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
                (OSing vid2
                  (Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                    ($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0))))))"
        then have ag:" Vagree (mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
                 (OSing vid2
                   (Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                     ($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))
         (χ y. if vid2 = y then 0 else fst (a, b) $ y, b) (sol t))
 (mk_xode I
   (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
     (OSing vid2
       (Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
         ($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))
   (sol t))
 (semBV I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
            (OSing vid2
              (Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                ($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0))))))" by auto
        have sembv:"(semBV I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
            (OSing vid2
              (Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                ($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))) = {Inl vid1, Inr vid1, Inl vid2, Inr vid2}" by auto
        have sub:"{Inl vid1} ⊆ {Inl vid1, Inr vid1, Inl vid2, Inr vid2}" by auto
        have ag':"Vagree (mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
                 (OSing vid2
                   (Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                     ($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))
         (χ y. if vid2 = y then 0 else fst (a, b) $ y, b) (sol t))
   (mk_xode I
     (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
       (OSing vid2
         (Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
           ($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))
     (sol t)) {Inl vid1}" using ag sembv agree_sub[OF sub] by auto
        then have "fst ?res_state $ vid1 = fst ((mk_xode I
     (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
       (OSing vid2
         (Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
           ($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))
     (sol t))) $ vid1" unfolding Vagree_def by blast
        moreover have "... = sol t $ vid1" by auto
        ultimately show "?thesis" by linarith
      qed
     have agree:"Vagree ?aaba' (?res_state) (FVF (p1 vid2 vid1))"
       unfolding p1_def Vagree_def using aabaX res_stateX by auto
     have fml_sem_eq:"(?res_state ∈ fml_sem I (p1 vid2 vid1)) = (?aaba' ∈ fml_sem I (p1 vid2 vid1))"
       using coincidence_formula[OF p2safe Iagree_refl agree, of I] by auto
     then show "Predicates I vid2
     (χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
            (mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
                      (OSing vid2
                        (Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                          ($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))
              (χ y. if vid2 = y then 0 else fst (a, b) $ y, b) (sol t)))"
     using pred2 unfolding p1_def expand_singleton by auto
  qed
subgoal for I a b r aa ba sol t
proof -
  assume good_interp:"is_interp I"
  assume bigAll:"    ∀aa ba. (∃sol t. (aa, ba) =
                     mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
                              (OSing vid2
                                (Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                                  ($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))
                      (χ y. if vid2 = y then r else fst (a, b) $ y, b) (sol t) ∧
                     0 ≤ t ∧
                     (sol solves_ode
                      (λa b. (χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0) +
                             (χ i. if i = vid2 then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1)) b else 0)))
                      {0..t} {x. Predicates I vid1
                                  (χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                                         (mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
                                                   (OSing vid2
                                                     (Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                                                       ($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))
                                           (χ y. if vid2 = y then r else fst (a, b) $ y, b) x))} ∧
                     VSagree (sol 0) (χ y. if vid2 = y then r else fst (a, b) $ y)
                      {uu. uu = vid2 ∨
                            uu = vid1 ∨
                            uu = vid2 ∨
                            uu = vid1 ∨
                            Inl uu
                            ∈ Inl ` ({x. ∃xa. Inl x ∈ FVT (if xa = vid1 then trm.Var vid1 else Const 0)} ∪
                                      {x. x = vid2 ∨ (∃xa. Inl x ∈ FVT (if xa = vid1 then trm.Var vid1 else Const 0))}) ∨
                            (∃x. Inl uu ∈ FVT (if x = vid1 then trm.Var vid1 else Const 0))}) ⟶
            Predicates I vid2 (χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (aa, ba))"
    assume aaba:"(aa, ba) = mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (sol t)"
    assume t:"0 ≤ t"
    assume sol:"(sol solves_ode (λa b. χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0)) {0..t}
     {x. Predicates I vid1
          (χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                 (mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) x))}"
    assume VSA:"VSagree (sol 0) a
     {uu. uu = vid1 ∨
           Inl uu ∈ Inl ` {x. ∃xa. Inl x ∈ FVT (if xa = vid1 then trm.Var vid1 else Const 0)} ∨
           (∃x. Inl uu ∈ FVT (if x = vid1 then trm.Var vid1 else Const 0))}"
    let ?xode = "(λa b. χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0)"
    let ?xconstraint = UNIV
    let ?ivl = "ll_on_open.existence_ivl {0 .. t} ?xode ?xconstraint 0 (sol 0)"
    have freef1:"dfree ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))"
      by(auto simp add: dfree_Fun dfree_Const)
    have simple_term_inverse':"⋀θ. dfree θ ⟹ raw_term (simple_term θ) = θ"
      using simple_term_inverse by auto
    have old_lipschitz:"local_lipschitz (UNIV::real set) UNIV (λa b. χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0)"
      apply(rule c1_implies_local_lipschitz[where f'="(λ (t,b). blinfun_vec(λ i. if i = vid1 then blin_frechet (good_interp I) (simple_term (Function fid1 (λ i. if i = vid1 then Var vid1 else Const 0))) b else Blinfun(λ _. 0)))"])
         apply auto
       subgoal for x
         apply(rule has_derivative_vec)
         subgoal for i
           apply(auto simp add:  bounded_linear_Blinfun_apply good_interp_inverse good_interp)
           apply(auto simp add: simple_term_inverse'[OF freef1])
           apply(cases "i = vid1")
            apply(auto simp add: f1_def expand_singleton)
         proof -
           let ?h = "(λb. Functions I fid1 (χ i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) b))"
           let ?h' = "(λb'. FunctionFrechet I fid1 (χ i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) x) (χ i. frechet I (if i = vid1 then trm.Var vid1 else Const 0) x b'))" 
           let ?f = "(λ b. (χ i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) b))"
           let ?f' = "(λ b'. (χ i. frechet I (if i = vid1 then trm.Var vid1 else Const 0) x b'))"
           let ?g = "Functions I fid1"
           let ?g'= "FunctionFrechet I fid1 (?f x)"
           have heq:"?h = ?g ∘ ?f" by(rule ext, auto)
           have heq':"?h' = ?g' ∘ ?f'" by(rule ext, auto)
           have fderiv:"(?f has_derivative ?f') (at x)"
             apply(rule has_derivative_vec)
             by (auto simp add: svar_deriv axis_def)
           have gderiv:"(?g has_derivative ?g') (at (?f x))"
             using good_interp unfolding is_interp_def by blast
           have gfderiv: "((?g ∘ ?f) has_derivative(?g' ∘ ?f')) (at x)"
             using fderiv gderiv diff_chain_at by blast
           have boring_eq:"(λb. Functions I fid1 (χ i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) b)) =
             sterm_sem I ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))"
             by(rule ext, auto)
           have "(?h has_derivative ?h') (at x)" using gfderiv heq heq' by auto
           then show "(sterm_sem I ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)) has_derivative
 (λv'. (THE f'. ∀x. (Functions I fid1 has_derivative f' x) (at x)) (χ i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) x)
        (χ i. frechet I (if i = vid1 then trm.Var vid1 else Const 0) x v')))
 (at x)"
             using boring_eq by auto
         qed
         done
    proof -
      have the_thing:"continuous_on (UNIV::('sz Rvec set)) 
        (λb.
          blinfun_vec
           (λi. if i = vid1 then blin_frechet (good_interp I) (simple_term ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) b
                else Blinfun (λ_. 0)))"
         apply(rule continuous_blinfun_vec')
         subgoal for i
           apply(cases "i = vid1")
            apply(auto)
            using frechet_continuous[OF good_interp freef1] by (auto simp add: continuous_on_const)           
         done
       have another_cont:"continuous_on (UNIV) 
        (λx.
          blinfun_vec
           (λi. if i = vid1 then blin_frechet (good_interp I) (simple_term ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (snd x)
                else Blinfun (λ_. 0)))"
         apply(rule continuous_on_compose2[of UNIV "(λb. blinfun_vec
           (λi. if i = vid1 then blin_frechet (good_interp I) (simple_term ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) b
                else Blinfun (λ_. 0)))"])
           apply(rule the_thing)
          by (auto intro!: continuous_intros)
       have ext:"(λx. case x of
        (t, b) ⇒
          blinfun_vec
           (λi. if i = vid1 then blin_frechet (good_interp I) (simple_term ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) b
                else Blinfun (λ_. 0))) =(λx.
          blinfun_vec
           (λi. if i = vid1 then blin_frechet (good_interp I) (simple_term ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (snd x)
           else Blinfun (λ_. 0))) " apply(rule ext, auto) 
         by (metis snd_conv)
       then show  "continuous_on (UNIV) 
        (λx. case x of
        (t, b) ⇒
          blinfun_vec
           (λi. if i = vid1 then blin_frechet (good_interp I) (simple_term ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) b
                else Blinfun (λ_. 0)))"
         using another_cont
         by (simp add: another_cont local.ext)
    qed
    have old_continuous:" ⋀x. x ∈ UNIV ⟹ continuous_on UNIV (λt. χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) x else 0)"
      by(rule continuous_on_const)
    interpret ll_old: ll_on_open_it "UNIV" ?xode ?xconstraint 0 
      apply(standard)
          subgoal by auto
         prefer 3 subgoal by auto
        prefer 3 subgoal by auto
       apply(rule old_lipschitz)
      by (rule old_continuous)
    let ?ivl = "(ll_old.existence_ivl 0 (sol 0))"
    let ?flow = "ll_old.flow 0 (sol 0)"
    have tclosed:"{0..t} = {0--t}" using t real_Icc_closed_segment by auto
    have "(sol  solves_ode (λa b. χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0)) {0..t} UNIV"
      apply(rule solves_ode_supset_range)
       apply(rule sol)
      by auto
    then have sol':"(sol  solves_ode (λa b. χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0)) {0--t} UNIV"
      using tclosed by auto
    have sub:"{0--t} ⊆ ll_old.existence_ivl 0 (sol 0)"
      apply(rule ll_old.closed_segment_subset_existence_ivl)
      apply(rule ll_old.existence_ivl_maximal_segment)
        apply(rule sol')
       apply(rule refl)
      by auto
    have usol_old:"(?flow  usolves_ode ?xode from 0) ?ivl UNIV"
      by(rule ll_old.flow_usolves_ode, auto)
    have sol_old:"(ll_old.flow 0 (sol 0) solves_ode ?xode) ?ivl UNIV"
      by(rule ll_old.flow_solves_ode, auto)
    have another_sub:"⋀s. s ∈ {0..t} ⟹ {s--0} ⊆ {0..t}"
      unfolding closed_segment_def
      apply auto
      by (metis diff_0_right diff_left_mono mult.commute mult_left_le order.trans)
    have sol_eq_flow:"⋀s. s ∈ {0..t} ⟹ sol s = ?flow s"
      using usol_old apply simp
      apply(drule usolves_odeD(4)) (* 7 subgoals*)
            apply auto
       subgoal for s x
       proof -
         assume xs0:"x ∈ {s--0}"
         assume s0:"0 ≤ s" and st: "s ≤ t"
         have "{s--0} ⊆ {0..t}" using another_sub[of s] s0 st by auto
         then have "x ∈ {0..t}" using xs0 by auto
         then have "x ∈ {0--t}" using tclosed by auto
         then show "x ∈ ll_old.existence_ivl 0 (sol 0)"
           using sub by auto
       qed
       apply(rule solves_ode_subset)
        using sol' apply auto[1]
       subgoal for s
       proof - 
         assume s0:"0 ≤ s" and st:"s ≤ t"
         show "{s--0} ⊆ {0--t}"
           using tclosed unfolding closed_segment using s0 st
           using another_sub intervalE by blast
       qed
      done
    have sol_deriv_orig:"⋀s. s∈?ivl ⟹  (?flow has_derivative (λxa. xa *⇩_R (χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (?flow s) else 0))) (at s within ?ivl)"
      using sol_old apply simp
      apply(drule solves_odeD(1))
      by (auto simp add: has_vderiv_on_def has_vector_derivative_def)
    have sol_eta:"(λt. χ i. ?flow t $ i) = ?flow" by(rule ext, rule vec_extensionality, auto)
    have sol_deriv_eq1:"⋀s i. (λxa. xa *⇩_R (χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (?flow s) else 0)) = (λxa. χ i. xa * (if i = vid1 then sterm_sem I (f1 fid1 vid1) (?flow s) else 0))"
      by(rule ext, rule vec_extensionality, auto)
    have sol_deriv_proj:"⋀s i. s∈?ivl ⟹  ((λt. ?flow t $ i) has_derivative (λxa. (xa *⇩_R (χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (?flow s) else 0)) $ i)) (at s within ?ivl)"         
      subgoal for s i
        apply(rule has_derivative_proj[of "(λ i t. ?flow t $ i)" "(λ i t'. (t' *⇩_R (χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (?flow s) else 0)) $ i)" "(at s within ?ivl)" "i"])
        using sol_deriv_orig[of s] sol_eta sol_deriv_eq1 by auto
      done
    have sol_deriv_eq2:"⋀s i. (λxa. xa * (if i = vid1 then sterm_sem I (f1 fid1 vid1) (?flow s) else 0)) = (λxa. (xa *⇩_R (χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (?flow s) else 0)) $ i)"
      by(rule ext, auto)
    have sol_deriv_proj':"⋀s i. s∈?ivl ⟹  ((λt. ?flow t $ i) has_derivative (λxa. xa * (if i = vid1 then sterm_sem I (f1 fid1 vid1) (?flow s) else 0))) (at s within ?ivl)"
      subgoal for s i using sol_deriv_proj[of s i] sol_deriv_eq2[of i s] by metis done  
    have sol_deriv_proj_vid1:"⋀s. s∈?ivl ⟹  ((λt. ?flow t $ vid1) has_derivative (λxa. xa * (sterm_sem I (f1 fid1 vid1) (?flow s)))) (at s within ?ivl)"
      subgoal for s
        using sol_deriv_proj'[of s vid1] by auto done
    have deriv1_args:"⋀s. s ∈ ?ivl ⟹ ((λ t. (χ i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (?flow t))) has_derivative ((λ t'. χ i . t' * (if i = vid1 then sterm_sem I (f1 fid1 vid1) (?flow s) else 0)))) (at s within ?ivl)"
      apply(rule has_derivative_vec)
      by (auto simp add: sol_deriv_proj_vid1)          
    have con_fid:"⋀fid. continuous_on ?ivl (λx. sterm_sem I (f1 fid vid1) (?flow x))"
      subgoal for fid
      apply(rule has_derivative_continuous_on[of "?ivl" "(λx. sterm_sem I (f1 fid vid1) (?flow x))"
          "(λt t'.  FunctionFrechet I fid (χ i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (?flow t)) (χ i . t' * (if i = vid1 then sterm_sem I (f1 fid1 vid1) (?flow t) else 0)))"])
    proof -
      fix s
      assume ivl:"s ∈ ?ivl"
      let ?h = "(λx. sterm_sem I (f1 fid vid1) (?flow x))"
      let ?g = "Functions I fid"
      let ?f = "(λx. (χ i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (?flow x)))"
      let ?h' = "(λt'. FunctionFrechet I fid (χ i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (?flow s))
              (χ i. t' * (if i = vid1 then sterm_sem I (f1 fid1 vid1) (?flow s) else 0)))"
      let ?g' = "FunctionFrechet I fid (?f s)"
      let ?f' = "(λ t'. χ i . t' * (if i = vid1 then sterm_sem I (f1 fid1 vid1) (?flow s) else 0))"
      have heq:"?h = ?g ∘ ?f" unfolding comp_def f1_def expand_singleton by auto
      have heq':"?h' = ?g' ∘ ?f'" unfolding comp_def by auto
      have fderiv:"(?f has_derivative ?f') (at s within ?ivl)"
        using deriv1_args[OF ivl] by auto
      have gderiv:"(?g has_derivative ?g') (at (?f s) within (?f ` ?ivl))"
        using good_interp unfolding is_interp_def 
        using  has_derivative_subset by blast
      have gfderiv:"((?g ∘ ?f) has_derivative (?g' ∘ ?f')) (at s within ?ivl)"
        using fderiv gderiv diff_chain_within by blast
      show "((λx. sterm_sem I (f1 fid vid1) (?flow x)) has_derivative
       (λt'. FunctionFrechet I fid (χ i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (?flow s))
              (χ i. t' * (if i = vid1 then sterm_sem I (f1 fid1 vid1) (?flow s) else 0))))
       (at s within ?ivl)"
        using heq heq' gfderiv by auto
    qed
    done
    have con:"⋀x. continuous_on (?ivl) (λt. x * sterm_sem I (f1 fid2 vid1) (?flow t) + sterm_sem I (f1 fid3 vid1) (?flow t))"
      apply(rule continuous_on_add)
       apply(rule continuous_on_mult_left)
       apply(rule con_fid[of fid2])
      by(rule con_fid[of fid3])
    let ?axis = "(λ i. Blinfun(axis i))"
    have bounded_linear_deriv:"⋀t. bounded_linear (λy' . y' *⇩_R  sterm_sem I (f1 fid2 vid1) (ll_old.flow 0 (sol 0) t))" 
      using bounded_linear_scaleR_left by blast
    have ll:"local_lipschitz (ll_old.existence_ivl 0 (sol 0)) UNIV (λt y. y * sterm_sem I (f1 fid2 vid1) (?flow t) + sterm_sem I (f1 fid3 vid1) (?flow t))"
      apply(rule c1_implies_local_lipschitz[where f'="(λ (t,y). Blinfun(λy' . y' *⇩_R  sterm_sem I (f1 fid2 vid1) (ll_old.flow 0 (sol 0) t)))"])
         apply auto
       subgoal for t x
         apply(rule has_derivative_add_const)
         proof -
           have deriv:"((λx. x * sterm_sem I (f1 fid2 vid1) (ll_old.flow 0 (sol 0) t)) has_derivative (λx. x * sterm_sem I (f1 fid2 vid1) (ll_old.flow 0 (sol 0) t))) (at x)"
             by(auto intro: derivative_eq_intros)
           have eq:"(λx. x * sterm_sem I (f1 fid2 vid1) (ll_old.flow 0 (sol 0) t)) = blinfun_apply (Blinfun (λy'. y' * sterm_sem I (f1 fid2 vid1) (ll_old.flow 0 (sol 0) t)))"
             apply(rule ext)
             using bounded_linear_deriv[of t]  by (auto simp add:  bounded_linear_Blinfun_apply)
           show "((λx. x * sterm_sem I (f1 fid2 vid1) (ll_old.flow 0 (sol 0) t)) has_derivative
              blinfun_apply (Blinfun (λy'. y' * sterm_sem I (f1 fid2 vid1) (ll_old.flow 0 (sol 0) t))))
              (at x)" using deriv eq by auto
         qed
      apply(auto intro: continuous_intros simp add: split_beta')
    proof -
      have bounded_linear:"⋀x. bounded_linear (λy'. y' * sterm_sem I (f1 fid2 vid1) x)" 
        by (simp add: bounded_linear_mult_left)
      have eq:"(λx. Blinfun (λy'. y' * sterm_sem I (f1 fid2 vid1) x)) = (λx. (sterm_sem I (f1 fid2 vid1) x) *⇩_R id_blinfun)"
        apply(rule ext, rule blinfun_eqI)
        subgoal for x i
          using bounded_linear[of x] apply(auto simp add: bounded_linear_Blinfun_apply)
          by (simp add: blinfun.scaleR_left)
        done
      have conFlow:"continuous_on (ll_old.existence_ivl 0 (sol 0)) (ll_old.flow 0 (sol 0))"
        using ll_old.general.flow_continuous_on by blast
      have conF':"continuous_on (ll_old.flow 0 (sol 0) ` ll_old.existence_ivl 0 (sol 0)) 
            (λx. (sterm_sem I (f1 fid2 vid1) x) *⇩_R id_blinfun)"
        apply(rule continuous_on_scaleR)
         apply(auto intro: continuous_intros)
        apply(rule sterm_continuous')
         apply(rule good_interp)
        by(auto simp add: f1_def intro: dfree.intros) 
      have conF:"continuous_on (ll_old.flow 0 (sol 0) ` ll_old.existence_ivl 0 (sol 0)) 
            (λx. Blinfun (λy'. y' * sterm_sem I (f1 fid2 vid1) x))"
        apply(rule continuous_on_compose2[of "UNIV" "(λx. Blinfun (λy'. y' * x))" "(ll_old.flow 0 (sol 0) ` ll_old.existence_ivl 0 (sol 0))" "sterm_sem I (f1 fid2 vid1)"]) 
          subgoal by (metis blinfun_mult_left.abs_eq bounded_linear_blinfun_mult_left continuous_on_eq linear_continuous_on)
         apply(rule sterm_continuous')
          apply(rule good_interp)
        by(auto simp add: f1_def intro: dfree.intros) 
      show "continuous_on (ll_old.existence_ivl 0 (sol 0) × UNIV) (λx. Blinfun (λy'. y' * sterm_sem I (f1 fid2 vid1) (ll_old.flow 0 (sol 0) (fst x))))"
        apply(rule continuous_on_compose2[of "ll_old.existence_ivl 0 (sol 0)" "(λx. Blinfun (λy'. y' * sterm_sem I (f1 fid2 vid1) (ll_old.flow 0 (sol 0) x)))" "(ll_old.existence_ivl 0 (sol 0) × UNIV)" "fst"])
          apply(rule continuous_on_compose2[of "(ll_old.flow 0 (sol 0) ` ll_old.existence_ivl 0 (sol 0))" "(λx. Blinfun (λy'. y' * sterm_sem I (f1 fid2 vid1) x))" 
                "(ll_old.existence_ivl 0 (sol 0))" "(ll_old.flow 0 (sol 0))"])
            using conF conFlow by (auto intro!: continuous_intros)
      qed
    let ?ivl = "ll_old.existence_ivl 0 (sol 0)"
    ― ‹Construct solution to ODE for ‹y'› here:›
    let ?yode = "(λt y. y * sterm_sem I (f1 fid2 vid1) (?flow t) + sterm_sem I (f1 fid3 vid1) (?flow t))"
    let ?ysol0 = r
    interpret ll_new: ll_on_open_it "?ivl" "?yode" "UNIV" 0
      apply(standard)
          apply(auto)
       apply(rule ll)
      by(rule con)
    have sol_new:"(ll_new.flow 0 r solves_ode ?yode) (ll_new.existence_ivl 0 r) UNIV"
      by(rule ll_new.flow_solves_ode, auto)
    have more_lipschitz:"⋀tm tM. tm ∈ ll_old.existence_ivl 0 (sol 0) ⟹
         tM ∈ ll_old.existence_ivl 0 (sol 0) ⟹
         ∃M L. ∀t∈{tm..tM}. ∀x. ¦x * sterm_sem I (f1 fid2 vid1) (?flow t) + sterm_sem I (f1 fid3 vid1) (?flow t)¦ ≤ M + L * ¦x¦"
    proof -
      fix tm tM
      assume tm:"tm ∈ ll_old.existence_ivl 0 (sol 0)"
      assume tM:"tM ∈ ll_old.existence_ivl 0 (sol 0)"
      let ?f2 = "(λt. sterm_sem I (f1 fid2 vid1) (ll_old.flow 0 (sol 0) t))"
      let ?f3 = "(λt. sterm_sem I (f1 fid3 vid1) (ll_old.flow 0 (sol 0) t))"
      let ?boundLP = "(λL t . (tm ≤ t ∧ t ≤ tM ⟶ ¦?f2 t¦ ≤ L))"
      let ?boundL = "(SOME L. (∀t. ?boundLP L t))"
      have compactT:"compact {tm..tM}" by auto
      have sub:"{tm..tM} ⊆ ll_old.existence_ivl 0 (sol 0)"
        by (metis atLeastatMost_empty_iff empty_subsetI ll_old.general.segment_subset_existence_ivl real_Icc_closed_segment tM tm)
      let ?f2abs = "(λx. abs(?f2 x))"
      have neg_compact:"⋀S::real set. compact S ⟹ compact ((λx. -x) ` S)"
        by(rule compact_continuous_image, auto intro: continuous_intros)
      have compactf2:"compact (?f2 ` {tm..tM})"
        apply(rule compact_continuous_image)
         apply(rule continuous_on_compose2[of UNIV "sterm_sem I (f1 fid2 vid1)" "{tm..tM}" "ll_old.flow 0 (sol 0)"])
           apply(rule sterm_continuous)
            apply(rule good_interp)
           subgoal by (auto intro: dfree.intros simp add: f1_def)
          apply(rule continuous_on_subset)
           prefer 2 apply (rule sub)
          subgoal using ll_old.general.flow_continuous_on by blast
         by auto
      then have boundedf2:"bounded (?f2 ` {tm..tM})" using compact_imp_bounded by auto
      then have boundedf2neg:"bounded ((λx. -x) ` ?f2 ` {tm..tM})" using compact_imp_bounded neg_compact by auto
      then have bdd_above_f2neg:"bdd_above ((λx. -x) ` ?f2 ` {tm..tM})" by (rule bounded_imp_bdd_above)
      then have bdd_above_f2:"bdd_above ( ?f2 ` {tm..tM})" using bounded_imp_bdd_above boundedf2 by auto
      have bdd_above_f2_abs:"bdd_above (abs ` ?f2 ` {tm..tM})" 
        using bdd_above_f2neg bdd_above_f2 unfolding bdd_above_def
        apply auto
        subgoal for M1 M2
          apply(rule exI[where x="max M1 M2"])
          by fastforce
        done
      then have theBound:"∃L. (∀t. ?boundLP L t)" 
        unfolding bdd_above_def norm_conv_dist 
        by (auto simp add: Ball_def Bex_def norm_conv_dist image_iff norm_bcontfun_def dist_blinfun_def)
      then have boundLP:"∀t. ?boundLP (?boundL) t" using someI[of "(λ L. ∀t. ?boundLP L t)"] by blast
      let ?boundMP = "(λM t. (tm ≤ t ∧ t ≤ tM ⟶ ¦?f3 t¦ ≤ M))"
      let ?boundM = "(SOME M. (∀t. ?boundMP M t))"
      have compactf3:"compact (?f3 ` {tm..tM})"
        apply(rule compact_continuous_image)
         apply(rule continuous_on_compose2[of UNIV "sterm_sem I (f1 fid3 vid1)" "{tm..tM}" "ll_old.flow 0 (sol 0)"])
           apply(rule sterm_continuous)
            apply(rule good_interp)
           subgoal by (auto intro: dfree.intros simp add: f1_def)
          apply(rule continuous_on_subset)
           prefer 2 apply (rule sub)
          subgoal using ll_old.general.flow_continuous_on by blast
         by auto
      then have boundedf3:"bounded (?f3 ` {tm..tM})" using compact_imp_bounded by auto
      then have boundedf3neg:"bounded ((λx. -x) ` ?f3 ` {tm..tM})" using compact_imp_bounded neg_compact by auto
      then have bdd_above_f3neg:"bdd_above ((λx. -x) ` ?f3 ` {tm..tM})" by (rule bounded_imp_bdd_above)
      then have bdd_above_f3:"bdd_above ( ?f3 ` {tm..tM})" using bounded_imp_bdd_above boundedf3 by auto
      have bdd_above_f3_abs:"bdd_above (abs ` ?f3 ` {tm..tM})" 
        using bdd_above_f3neg bdd_above_f3 unfolding bdd_above_def
        apply auto
        subgoal for M1 M2
          apply(rule exI[where x="max M1 M2"])
          by fastforce
        done
      then have theBound:"∃L. (∀t. ?boundMP L t)"
        unfolding bdd_above_def norm_conv_dist
        by (auto simp add: Ball_def Bex_def norm_conv_dist image_iff norm_bcontfun_def dist_blinfun_def)
      then have boundMP:"∀t. ?boundMP (?boundM) t" using someI[of "(λ M. ∀t. ?boundMP M t)"] by blast
      show "∃M L. ∀t∈{tm..tM}. ∀x. ¦x * ?f2 t + ?f3 t¦ ≤ M + L * ¦x¦"
        apply(rule exI[where x="?boundM"])
        apply(rule exI[where x="?boundL"])
        apply auto
      proof -
        fix t and x :: real
        assume ttm:"tm ≤ t"
        assume ttM:"t ≤ tM"
        from ttm ttM have ttmM:"tm ≤ t ∧ t ≤ tM" by auto 
        have leqf3:"¦?f3 t¦ ≤ ?boundM" using boundMP ttmM by auto
        have leqf2:"¦?f2 t¦ ≤ ?boundL" using boundLP ttmM by auto
        have gr0:" ¦x¦ ≥ 0" by auto
        have leqf2x:"¦?f2 t¦ * ¦x¦ ≤ ?boundL * ¦x¦" using gr0 leqf2
          by (metis (no_types, lifting) real_scaleR_def scaleR_right_mono)
        have "¦x * ?f2 t + ?f3 t¦ ≤ ¦x¦ * ¦?f2 t¦ + ¦?f3 t¦"
          proof -
            have f1: "⋀r ra. ¦r::real¦ * ¦ra¦ = ¦r * ra¦"
              by (metis norm_scaleR real_norm_def real_scaleR_def)
            have "⋀r ra. ¦(r::real) + ra¦ ≤ ¦r¦ + ¦ra¦"
              by (metis norm_triangle_ineq real_norm_def)
              then show ?thesis
              using f1 by presburger
          qed
        moreover have "... = ¦?f3 t¦ + ¦?f2 t¦ * ¦x¦"
          by auto
        moreover have "... ≤ ?boundM + ¦?f2 t¦ * ¦x¦"
          using leqf3 by linarith
        moreover have "... ≤ ?boundM + ?boundL * ¦x¦"
          using leqf2x  by linarith
        ultimately show "¦x * ?f2 t + ?f3 t¦ ≤ ?boundM + ?boundL * ¦x¦"
          by linarith
      qed
    qed
    have ivls_eq:"(ll_new.existence_ivl 0 r) = (ll_old.existence_ivl 0 (sol 0))"
      apply(rule ll_new.existence_ivl_eq_domain)
          apply auto
      apply (rule more_lipschitz)
      by auto
    have sub':"{0--t} ⊆ ll_new.existence_ivl 0 r"
      using sub ivls_eq by auto
    have sol_new':"(ll_new.flow 0 r solves_ode ?yode) {0--t} UNIV"
      by(rule solves_ode_subset, rule sol_new, rule sub')
    let ?soly = "ll_new.flow 0 r"
    let ?sol' = "(λt. χ i. if i = vid2 then ?soly t else sol t $ i)"
    let ?aaba' = "mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
                             (OSing vid2
                               (Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                                 ($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))
                         (χ y. if vid2 = y then r else fst (a, b) $ y, b)
                         (?sol' t)"
    have duh:"(fst ?aaba', snd ?aaba') = ?aaba'" by auto
    note bigEx = spec[OF spec[OF bigAll, where x="fst ?aaba'"], where x="snd ?aaba'"]
    have sol_deriv:"⋀s. s ∈ {0..t} ⟹ (sol has_derivative (λxa. xa *⇩_R (χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (sol s) else 0))) (at s within {0..t})"
       using sol apply simp
       by(drule solves_odeD(1), auto simp add: has_vderiv_on_def has_vector_derivative_def)
     have silly_eq1:"(λt. χ i. sol t $ i) = sol"
       by(rule ext, rule vec_extensionality, auto)
     have silly_eq2:"⋀s. (λxa. χ i. (xa *⇩_R (χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (sol s) else 0)) $ i) = (λxa. xa *⇩_R (χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (sol s) else 0))"
       by(rule ext, rule vec_extensionality, auto)
     have sol_proj_deriv:"⋀s i. s ∈ {0..t} ⟹ ((λ t. sol t $ i) has_derivative (λxa. (xa *⇩_R (χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (sol s) else 0)) $ i)) (at s within {0..t})"
       subgoal for s i
         apply(rule has_derivative_proj)
         using sol_deriv[of s] silly_eq1 silly_eq2[of s] by auto
       done
     have sol_proj_deriv_vid1:"⋀s. s ∈ {0..t} ⟹ ((λ t. sol t $ vid1) has_derivative (λxa. xa * sterm_sem I (f1 fid1 vid1) (sol s))) (at s within {0..t})"
       subgoal for s using sol_proj_deriv[of s vid1] by auto done
     have sol_proj_deriv_other:"⋀s i. s ∈ {0..t} ⟹ i ≠ vid1 ⟹ ((λ t. sol t $ i) has_derivative (λxa. 0)) (at s within {0..t})"
       subgoal for s i using sol_proj_deriv[of s i] by auto done
     have fact:"⋀x. x ∈{0..t} ⟹
   (ll_new.flow 0 r has_derivative
    (λxa. xa *⇩_R (ll_new.flow 0 r x * sterm_sem I (f1 fid2 vid1) (ll_old.flow 0 (sol 0) x) +
                  sterm_sem I (f1 fid3 vid1) (ll_old.flow 0 (sol 0) x))))
    (at x within {0 .. t})"
       using sol_new' apply simp
       apply(drule solves_odeD(1))
       using tclosed unfolding has_vderiv_on_def has_vector_derivative_def by auto
     have new_sol_deriv:"⋀s. s ∈ {0..t} ⟹ (ll_new.flow 0 r has_derivative
      (λxa. xa *⇩_R (ll_new.flow 0 r s * sterm_sem I (f1 fid2 vid1) (sol s) + sterm_sem I (f1 fid3 vid1) (sol s))))
      (at s within {0.. t})"
       subgoal for s
         using fact[of s] tclosed sol_eq_flow[of s] by auto
       done
     have sterm_agree:"⋀s. Vagree (χ i. if i = vid2 then ll_new.flow 0 r s else sol s $ i, undefined) (sol s, undefined) {Inl vid1}"
       subgoal for s unfolding Vagree_def using vne12 by auto done
     have FVF:"(FVT (f1 fid2 vid1)) = {Inl vid1}" unfolding f1_def expand_singleton apply auto subgoal for x xa by (cases "xa = vid1", auto) done
     have FVF2:"(FVT (f1 fid3 vid1)) = {Inl vid1}" unfolding f1_def expand_singleton apply auto subgoal for x xa by (cases "xa = vid1", auto) done
     have sterm_agree_FVF:"⋀s. Vagree (χ i. if i = vid2 then ll_new.flow 0 r s else sol s $ i, undefined) (sol s, undefined) (FVT (f1 fid2 vid1))"
       using sterm_agree FVF by auto
     have sterm_agree_FVF2:"⋀s. Vagree (χ i. if i = vid2 then ll_new.flow 0 r s else sol s $ i, undefined) (sol s, undefined) (FVT (f1 fid3 vid1))"
       using sterm_agree FVF2 by auto
     have y_component_sem_eq2:"⋀s. sterm_sem I (f1 fid2 vid1) (χ i. if i = vid2 then ll_new.flow 0 r s else sol s $ i)
        = sterm_sem I (f1 fid2 vid1) (sol s)"
       using coincidence_sterm[OF sterm_agree_FVF, of I] by auto
     have y_component_sem_eq3:"⋀s. sterm_sem I (f1 fid3 vid1) (χ i. if i = vid2 then ll_new.flow 0 r s else sol s $ i)
        = sterm_sem I (f1 fid3 vid1) (sol s)"
       using coincidence_sterm[OF sterm_agree_FVF2, of I] by auto
     have y_component_ode_eq:"⋀s. s ∈ {0..t} ⟹ 
       (λxa. xa * (ll_new.flow 0 r s * sterm_sem I (f1 fid2 vid1) (sol s) + sterm_sem I (f1 fid3 vid1) (sol s)))
     = (λxa. xa * (sterm_sem I (f1 fid2 vid1) (χ i. if i = vid2 then ll_new.flow 0 r s else sol s $ i) * ll_new.flow 0 r s +
             sterm_sem I (f1 fid3 vid1) (χ i. if i = vid2 then ll_new.flow 0 r s else sol s $ i)))"
       subgoal for s
         apply(rule ext)
         subgoal for xa
           using y_component_sem_eq2 y_component_sem_eq3 by auto
         done
       done
     have agree_vid1:"⋀s. Vagree (sol s, undefined) (χ i. if i = vid2 then ll_new.flow 0 r s else sol s $ i, undefined) {Inl vid1}"
       unfolding Vagree_def using vne12 by auto
     have FVT_vid1:"FVT(f1 fid1 vid1) = {Inl vid1}" apply(auto simp add: f1_def) subgoal for x xa apply(cases "xa = vid1") by auto done
     have agree_vid1_FVT:"⋀s. Vagree (sol s, undefined) (χ i. if i = vid2 then ll_new.flow 0 r s else sol s $ i, undefined) (FVT (f1 fid1 vid1))"
       using FVT_vid1 agree_vid1 by auto
     have sterm_eq_vid1:"⋀s. sterm_sem I (f1 fid1 vid1) (sol s) = sterm_sem I (f1 fid1 vid1) (χ i. if i = vid2 then ll_new.flow 0 r s else sol s $ i)"
       subgoal for  s
         using coincidence_sterm[OF agree_vid1_FVT[of s], of I] by auto
       done
     have vid1_deriv_eq:"⋀s. (λxa. xa * sterm_sem I (f1 fid1 vid1) (sol s)) =
       (λxa. xa * sterm_sem I (f1 fid1 vid1) (χ i. if i = vid2 then ll_new.flow 0 r s else sol s $ i))"
       subgoal for s
         apply(rule ext)
         subgoal for x'
           using sterm_eq_vid1[of s] by auto
         done done
     have inner_deriv:"⋀s. s ∈ {0..t} ⟹
   ((λt. χ i. if i = vid2 then ll_new.flow 0 r t else sol t $ i) has_derivative (λxa. (χ i. xa * (if i = vid1 then sterm_sem I (f1 fid1 vid1) (χ i. if i = vid2 then ll_new.flow 0 r s else sol s $ i) else
                                         if i = vid2 then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1)) (χ i. if i = vid2 then ll_new.flow 0 r s else sol s $ i) else 0))))
                                         (at s within {0..t})"
       subgoal for s
         apply(rule has_derivative_vec)
         subgoal for i
           apply(cases "i = vid2")
           subgoal
             using vne12
             using new_sol_deriv[of s]
             using y_component_ode_eq by auto
           subgoal 
             apply(cases "i = vid1")
             using sol_proj_deriv_vid1[of s] vid1_deriv_eq[of s] sol_proj_deriv_other[of s i] by auto
           done
         done
       done
     have deriv_eta:"⋀s. (λxa. xa *⇩_R ((χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (χ i. if i = vid2 then ll_new.flow 0 r s else sol s $ i) else 0) +
               (χ i. if i = vid2
                     then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1))
                           (χ i. if i = vid2 then ll_new.flow 0 r s else sol s $ i)
                     else 0)))
                     = (λxa. (χ i. xa * (if i = vid1 then sterm_sem I (f1 fid1 vid1) (χ i. if i = vid2 then ll_new.flow 0 r s else sol s $ i) else
                                         if i = vid2 then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1)) (χ i. if i = vid2 then ll_new.flow 0 r s else sol s $ i) else 0))) "
       subgoal for s
         apply(rule ext)
         apply(rule vec_extensionality)
         using vne12 by auto
       done
     have sol'_deriv:"⋀s. s ∈ {0..t} ⟹
   ((λt. χ i. if i = vid2 then ll_new.flow 0 r t else sol t $ i) has_derivative
    (λxa. xa *⇩_R ((χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (χ i. if i = vid2 then ll_new.flow 0 r s else sol s $ i) else 0) +
                  (χ i. if i = vid2
                        then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1))
                              (χ i. if i = vid2 then ll_new.flow 0 r s else sol s $ i)
                        else 0))))
    (at s within {0..t})"
       subgoal for s
         using inner_deriv[of s] deriv_eta[of s] by auto done
     have FVT:"⋀i. FVT (if i = vid1 then trm.Var vid1 else Const 0) ⊆ {Inl vid1}" by auto
     have agree:"⋀s. Vagree (mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (sol s)) (mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
                  (OSing vid2
                    (Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                      ($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))
          (χ y. if vid2 = y then r else fst (a, b) $ y, b) (χ i. if i = vid2 then ll_new.flow 0 r s else sol s $ i)) {Inl vid1}"
       subgoal for s
         using mk_v_agree [of "I" "(OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))" "(a, b)" "(sol s)"]
         using mk_v_agree [of I "(OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
                  (OSing vid2
                    (Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                      ($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))" "(χ y. if vid2 = y then r else fst (a, b) $ y, b)" "(χ i. if i = vid2 then ll_new.flow 0 r s else sol s $ i)"]
         unfolding Vagree_def using vne12 by simp
       done
     have agree':"⋀s i. Vagree (mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (sol s)) (mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
                  (OSing vid2
                    (Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                      ($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))
          (χ y. if vid2 = y then r else fst (a, b) $ y, b) (χ i. if i = vid2 then ll_new.flow 0 r s else sol s $ i)) (FVT (if i = vid1 then trm.Var vid1 else Const 0))"
       subgoal for s i using agree_sub[OF FVT[of i] agree[of s]] by auto done
     have safe:"⋀i. dsafe (if i = vid1 then trm.Var vid1 else Const 0)" subgoal for i apply(cases "i = vid1", auto) done done           
     have dterm_sem_eq:"⋀s i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (sol s)) 
       = dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
       (mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
                  (OSing vid2
                    (Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                      ($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))
          (χ y. if vid2 = y then r else fst (a, b) $ y, b) (χ i. if i = vid2 then ll_new.flow 0 r s else sol s $ i))"
       subgoal for s i using coincidence_dterm[OF safe[of i] agree'[of s i], of I] by auto done
     have dterm_vec_eq:"⋀s. (χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (sol s)))
       = (χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
       (mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
                  (OSing vid2
                    (Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                      ($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))
          (χ y. if vid2 = y then r else fst (a, b) $ y, b) (χ i. if i = vid2 then ll_new.flow 0 r s else sol s $ i)))"
       subgoal for s
         apply(rule vec_extensionality)
         subgoal for i using dterm_sem_eq[of i s] by auto
         done done
     have pred_same:"⋀s. s ∈ {0..t} ⟹ Predicates I vid1
        (χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
               (mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (sol s))) ⟹
Predicates I vid1
 (χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
        (mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
                  (OSing vid2
                    (Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                      ($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))
          (χ y. if vid2 = y then r else fst (a, b) $ y, b) (χ i. if i = vid2 then ll_new.flow 0 r s else sol s $ i)))"
       subgoal for s using dterm_vec_eq[of s] by auto done
   have sol'_domain:"⋀s. 0 ≤ s ⟹
  s ≤ t ⟹
  Predicates I vid1
   (χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
          (mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
                    (OSing vid2
                      (Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                        ($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))
                        (χ y. if vid2 = y then r else fst (a, b) $ y, b) (χ i. if i = vid2 then ll_new.flow 0 r s else sol s $ i)))"
       subgoal for s
         using sol apply simp
         apply(drule solves_odeD(2))
         using pred_same[of s] by auto
       done
     have sol':"(?sol' solves_ode
 (λa b. (χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0) +
        (χ i. if i = vid2 then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1)) b else 0)))
 {0..t} {x. Predicates I vid1
             (χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                    (mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
                              (OSing vid2
                                (Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                                  ($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))
                      (χ y. if vid2 = y then r else fst (a, b) $ y, b) x))}"
       apply(rule solves_odeI)
       subgoal
         unfolding has_vderiv_on_def has_vector_derivative_def
         using sol'_deriv by auto
       by(auto, rule sol'_domain, auto)
     have set_eq:"{y. y = vid2 ∨ y = vid1 ∨ y = vid2 ∨ y = vid1 ∨ (∃x. Inl y ∈ FVT (if x = vid1 then trm.Var vid1 else Const 0))} = {vid1, vid2}"
       by auto
     have "VSagree (?sol' 0) (χ y. if vid2 = y then r else fst (a, b) $ y) {vid1, vid2}"
       using VSA unfolding VSagree_def by simp 
     then have VSA':" VSagree (?sol' 0) (χ y. if vid2 = y then r else fst (a, b) $ y)
       
 {y. y = vid2 ∨ y = vid1 ∨ y = vid2 ∨ y = vid1 ∨ (∃x. Inl y ∈ FVT (if x = vid1 then trm.Var vid1 else Const 0))} "
       by (auto simp add: set_eq)
     have bigPre:"(∃sol t. (fst ?aaba', snd ?aaba') =
                    mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
                             (OSing vid2
                               (Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                                 ($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))
                     ((χ y. if vid2 = y then r else fst (a,b) $ y), b) (sol t) ∧
                    0 ≤ t ∧
                    (sol solves_ode
                     (λa b. (χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0) +
                            (χ i. if i = vid2 then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1)) b else 0)))
                     {0..t} {x. Predicates I vid1
                                 (χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
                                        (mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
                                                  (OSing vid2
                                                    (Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                                                      ($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))
                                          ((χ y. if vid2 = y then r else (fst (a,b)) $ y), b) x))} ∧
                    VSagree (sol 0) (χ y. if vid2 = y then r else fst (a,b) $ y)
                     {uu. uu = vid2 ∨
                    uu = vid1 ∨
                    uu = vid2 ∨
                    uu = vid1 ∨
                    Inl uu ∈ Inl ` ({x. ∃xa. Inl x ∈ FVT (if xa = vid1 then trm.Var vid1 else Const 0)} ∪
                                     {x. x = vid2 ∨ (∃xa. Inl x ∈ FVT (if xa = vid1 then trm.Var vid1 else Const 0))}) ∨
                    (∃x. Inl uu ∈ FVT (if x = vid1 then trm.Var vid1 else Const 0))})"
       apply(rule exI[where x="?sol'"])
       apply(rule exI[where x=t])
       apply(rule conjI)
        subgoal by simp
       apply(rule conjI)
        subgoal by (rule t)
       apply(rule conjI)
        apply(rule sol')
        using VSA' unfolding VSagree_def by auto
     have pred_sem:"Predicates I vid2 (χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) ?aaba')"
       using mp[OF bigEx bigPre] by auto
     let ?other_state = "(mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (sol t))"
     have agree:"Vagree (?aaba') (?other_state) {Inl vid1} "
       using mk_v_agree [of "I" "(OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
                 (OSing vid2
                   (Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
                     ($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))"
         "(χ y. if vid2 = y then r else fst (a, b) $ y, b)" "(?sol' t)"]
       using mk_v_agree [of "I" "(OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))" "(a, b)" "(sol t)"]
       unfolding Vagree_def using vne12 by simp
     have sub:"⋀i. FVT (if i = vid1 then trm.Var vid1 else Const 0) ⊆ {Inl vid1}"
       by auto
     have agree':"⋀i. Vagree (?aaba') (?other_state) (FVT (if i = vid1 then trm.Var vid1 else Const 0)) "
       subgoal for i using agree_sub[OF sub[of i] agree] by auto done
     have silly_safe:"⋀i. dsafe (if i = vid1 then trm.Var vid1 else Const 0)"
       subgoal for i
         apply(cases "i = vid1")
          by (auto simp add: dsafe_Var dsafe_Const)
       done
     have dsem_eq:"(χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) ?aaba')  = 
        (χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) ?other_state)"
       apply(rule vec_extensionality)
       subgoal for i
         using coincidence_dterm[OF silly_safe[of i] agree'[of i], of I] by auto
       done
     show
    "Predicates I vid2
     (χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
            (mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (sol t)))"
     using pred_sem dsem_eq by auto
 qed


done
qed
end end

Theory USubst_Lemma

theory "USubst_Lemma"
imports
  Ordinary_Differential_Equations.ODE_Analysis
  "Ids"
  "Lib"
  "Syntax"
  "Denotational_Semantics"
  "Frechet_Correctness"
  "Static_Semantics"
  "Coincidence"
  "Bound_Effect"
  "USubst"
begin context ids begin
section ‹Soundness proof for uniform substitution rule›
lemma interp_eq:
  "f = f' ⟹ p = p' ⟹ c = c' ⟹ PP = PP' ⟹ ode = ode' ⟹ odebv = odebv' ⟹
   ⦇Functions = f, Predicates = p, Contexts = c, Programs = PP, ODEs = ode, ODEBV = odebv⦈ =
   ⦇Functions = f', Predicates = p', Contexts = c', Programs = PP', ODEs = ode', ODEBV = odebv'⦈"
  by auto

subsection ‹Lemmas about well-formedness of (adjoint) interpretations.›

text ‹When adding a function to an interpretation with {\tt extendf}, we need to show it's C1 continuous.
  We do this by explicitly constructing the derivative {\tt extendf\_deriv} and showing it's continuous.›
primrec extendf_deriv :: "('sf,'sc,'sz) interp ⇒ 'sf ⇒ ('sf + 'sz,'sz) trm ⇒ 'sz state ⇒ 'sz Rvec ⇒ ('sz Rvec ⇒ real)"
where
  "extendf_deriv I _ (Var i) ν x = (λ_. 0)"
| "extendf_deriv I _ (Const r) ν x = (λ_. 0)"
| "extendf_deriv I g (Function f args) ν x =
  (case f of 
    Inl ff ⇒ (THE f'. ∀y. (Functions I ff has_derivative f' y) (at y))
              (χ i. dterm_sem
                     ⦇Functions = case_sum (Functions I) (λf' _. x $ f'), Predicates = Predicates I, Contexts = Contexts I, Programs = Programs I,
                        ODEs = ODEs I, ODEBV = ODEBV I⦈
                     (args i) ν) ∘
             (λν'. χ ia. extendf_deriv I g (args ia) ν x ν')
  | Inr ff ⇒ (λ ν'. ν' $ ff))"
| "extendf_deriv I g (Plus t1 t2) ν x = (λν'. (extendf_deriv I g t1 ν x ν') + (extendf_deriv I g t2 ν x ν'))"
| "extendf_deriv I g (Times t1 t2) ν x = 
   (λν'. ((dterm_sem (extendf I x) t1 ν * (extendf_deriv I g t2 ν x ν'))) 
       + (extendf_deriv I g t1 ν x ν') * (dterm_sem (extendf I x) t2 ν))"
| "extendf_deriv I g ($' _) ν = undefined"
| "extendf_deriv I g (Differential _) ν = undefined"

lemma extendf_dterm_sem_continuous:
  fixes f'::"('sf + 'sz,'sz) trm" and I::"('sf,'sc,'sz) interp"
  assumes free:"dfree f'"
  assumes good_interp:"is_interp I"
  shows "continuous_on UNIV (λx. dterm_sem (extendf I x) f' ν)"
proof(induction rule: dfree.induct[OF free])
  case (3 args f)
  then show ?case 
    apply(cases f)
     apply (auto simp add: continuous_intros)
    subgoal for a
      apply(rule continuous_on_compose2[of UNIV "Functions I a" UNIV "(λ x. (χ i. dterm_sem
                       ⦇Functions = case_sum (Functions I) (λf' _. x $ f'), Predicates = Predicates I, Contexts = Contexts I,
                          Programs = Programs I, ODEs = ODEs I, ODEBV = ODEBV I⦈
                       (args i) ν))"])
      subgoal
        using is_interpD[OF good_interp]
        using has_derivative_continuous_on[of UNIV "(Functions I a)" "(THE f'. ∀x. (Functions I a has_derivative f' x) (at x))"] 
        by auto
      apply(rule continuous_on_vec_lambda) by auto
    done
qed (auto simp add: continuous_intros)

lemma extendf_deriv_bounded:
  fixes f'::"('sf + 'sz,'sz) trm" and I::"('sf,'sc,'sz) interp"
  assumes free:"dfree f'"
  assumes good_interp:"is_interp I"
  shows "bounded_linear (extendf_deriv I i f' ν x)"
proof(induction rule: dfree.induct[OF free])
  case (1 i)
  then show ?case by auto
next
  case (2 r)
  then show ?case by auto
next
  case (3 args f)
  then show ?case apply auto
    apply(cases f)
     apply auto
    subgoal for a
      apply(rule bounded_linear_compose[of "(THE f'. ∀y. (Functions I a has_derivative f' y) (at y))
           (χ i. dterm_sem
                  ⦇Functions = case_sum (Functions I) (λf' _. x $ f'), Predicates = Predicates I, Contexts = Contexts I, Programs = Programs I,
                     ODEs = ODEs I, ODEBV = ODEBV I⦈
                  (args i) ν)"])
       subgoal using good_interp unfolding is_interp_def  using has_derivative_bounded_linear  by fastforce
      apply(rule bounded_linear_vec)
      by auto
    done
next
  case (4 θ⇩₁ θ⇩₂)
  then show ?case apply auto
    using bounded_linear_add by blast
next
  case (5 θ⇩₁ θ⇩₂)
  then show ?case apply auto
    apply(rule bounded_linear_add)
     apply(rule bounded_linear_const_mult)
     subgoal by auto
    apply(rule bounded_linear_mult_const)
    subgoal by auto
    done
qed

lemma extendf_deriv_continuous:
  fixes f'::"('sf + 'sz,'sz) trm" and I::"('sf,'sc,'sz) interp"
  assumes free:"dfree f'"
  assumes good_interp:"is_interp I"
  shows "continuous_on UNIV (λx. Blinfun (extendf_deriv I i f' ν x))"
proof (induction rule: dfree.induct[OF free])
  case (3 args f)
  assume dfrees:"⋀i. dfree (args i)"
  assume const:"⋀j. continuous_on UNIV (λx. Blinfun (extendf_deriv I i (args j) ν x))"
  then show ?case 
    unfolding extendf_deriv.simps
    apply(cases f)
    subgoal for a 
      apply simp
      proof -
        have boundedF:"⋀x. bounded_linear (((THE f'. ∀y. (Functions I a has_derivative f' y) (at y))
                          (χ i. dterm_sem (extendf I x) (args i) ν) ))"
          using blinfun.bounded_linear_right using good_interp unfolding is_interp_def 
          by auto
        have boundedG:"⋀x. bounded_linear (λ b. (χ ia. extendf_deriv I i (args ia) ν x b))"
          by (simp add: bounded_linear_vec dfrees extendf_deriv_bounded good_interp)
        have boundedH:"⋀x. bounded_linear (λb. (THE f'. ∀y. (Functions I a has_derivative f' y) (at y))
                          (χ i. dterm_sem
                          (extendf I x)
                                 
                                 (args i) ν)
                          (χ ia. extendf_deriv I i (args ia) ν x b))"
          using bounded_linear_compose  boundedG boundedF by blast
        have eq:"(λx. Blinfun (λb. (THE f'. ∀y. (Functions I a has_derivative f' y) (at y))
                          (χ i. dterm_sem
                                 (extendf I x)
                                 (args i) ν)
                          (χ ia. extendf_deriv I i (args ia) ν x b)))
                          = 
                (λx. blinfun_compose(Blinfun((THE f'. ∀y. (Functions I a has_derivative f' y) (at y))
                          (χ i. dterm_sem
                                 (extendf I x)
                                 (args i) ν) )) (Blinfun(λ b. (χ ia. extendf_deriv I i (args ia) ν x b))))"
          apply(rule ext)
          apply(rule blinfun_eqI)
          subgoal for x ia
            using boundedG[of x]  blinfun_apply_blinfun_compose bounded_linear_Blinfun_apply
          proof -
            have f1: "bounded_linear (λv. FunctionFrechet I a (χ s. dterm_sem (extendf I x) (args s) ν) (χ s. extendf_deriv I i (args s) ν x v))"
              using FunctionFrechet.simps ‹bounded_linear (λb. (THE f'. ∀y. (Functions I a has_derivative f' y) (at y)) (χ i. dterm_sem (extendf I x) (args i) ν) (χ ia. extendf_deriv I i (args ia) ν x b))›
              by fastforce          
            have "bounded_linear (FunctionFrechet I a (χ s. dterm_sem (extendf I x) (args s) ν))"
              using good_interp is_interp_def by blast
            then have "blinfun_apply (Blinfun (FunctionFrechet I a (χ s. dterm_sem (extendf I x) (args s) ν))) (χ s. extendf_deriv I i (args s) ν x ia) = blinfun_apply (Blinfun (λv. FunctionFrechet I a (χ s. dterm_sem (extendf I x) (args s) ν) (χ s. extendf_deriv I i (args s) ν x v))) ia"
              using f1 by (simp add: bounded_linear_Blinfun_apply)
            then have "blinfun_apply (Blinfun (FunctionFrechet I a (χ s. dterm_sem (extendf I x) (args s) ν))) (χ s. extendf_deriv I i (args s) ν x ia) = blinfun_apply (Blinfun (λv. FunctionFrechet I a (χ s. dterm_sem (extendf I x) (args s) ν) (χ s. extendf_deriv I i (args s) ν x v))) ia ∧ bounded_linear (λv. χ s. extendf_deriv I i (args s) ν x v)"
              by (metis ‹bounded_linear (λb. χ ia. extendf_deriv I i (args ia) ν x b)›) (* failed *)
            then show ?thesis
              by (simp add: bounded_linear_Blinfun_apply)
          qed
        done
        have bounds:"⋀ia x. bounded_linear (extendf_deriv I i (args ia) ν x)" 
          by (simp add: dfrees extendf_deriv_bounded good_interp)
        have vec_bound:"⋀x. bounded_linear (λb. χ ia. extendf_deriv I i (args ia) ν x b)" 
          by (simp add: boundedG)
        have blinfun_vec:"(λx. Blinfun (λb. χ ia. extendf_deriv I i (args ia) ν x b)) = (λx. blinfun_vec (λ ia.  Blinfun(λb. extendf_deriv I i (args ia) ν x b)))"
          apply(rule ext)
          apply(rule blinfun_eqI)
          apply(rule vec_extensionality)
          subgoal for x y ia
          proof -
            have "(χ s. extendf_deriv I i (args s) ν x y) $ ia = blinfun_apply (blinfun_vec (λs. Blinfun (extendf_deriv I i (args s) ν x))) y $ ia"
              by (simp add: bounded_linear_Blinfun_apply bounds)
            then have "(χ s. extendf_deriv I i (args s) ν x y) $ ia = blinfun_apply (blinfun_vec (λs. Blinfun (extendf_deriv I i (args s) ν x))) y $ ia ∧ bounded_linear (λv. χ s. extendf_deriv I i (args s) ν x v)"
              by (metis ‹bounded_linear (λb. χ ia. extendf_deriv I i (args ia) ν x b)›)
            then show ?thesis
              by (simp add: bounded_linear_Blinfun_apply)
          qed
          done
        have vec_cont:"continuous_on UNIV (λx. blinfun_vec (λ ia.  Blinfun(λb. extendf_deriv I i (args ia) ν x b)))"
          apply(rule continuous_blinfun_vec')
          using "3.IH" by blast
        have cont_intro:"⋀ f g s. continuous_on s f ⟹ continuous_on s g ⟹ continuous_on s (λx. f x  o⇩_L  g x)"
          by(auto intro: continuous_intros)
        have cont:"continuous_on UNIV (λx. blinfun_compose(Blinfun((THE f'. ∀y. (Functions I a has_derivative f' y) (at y))
                          (χ i. dterm_sem
                                 ⦇Functions = case_sum (Functions I) (λf' _. x $ f'), Predicates = Predicates I, Contexts = Contexts I,
                                    Programs = Programs I, ODEs = ODEs I, ODEBV = ODEBV I⦈
                                 (args i) ν) )) (Blinfun(λ b. (χ ia. extendf_deriv I i (args ia) ν x b))))"
          apply(rule cont_intro)
           defer
           subgoal using blinfun_vec vec_cont by presburger
          apply(rule continuous_on_compose2[of UNIV "(λx. Blinfun ((THE f'. ∀y. (Functions I a has_derivative f' y) (at y)) x))"])
            subgoal using good_interp unfolding is_interp_def by simp
           apply(rule continuous_on_vec_lambda)
           subgoal for i using extendf_dterm_sem_continuous[OF dfrees[of i] good_interp] by auto
          by auto
        then show " continuous_on UNIV
       (λx. Blinfun (λb. (THE f'. ∀y. (Functions I a has_derivative f' y) (at y))
                          (χ i. dterm_sem
                                 ⦇Functions = case_sum (Functions I) (λf' _. x $ f'), Predicates = Predicates I, Contexts = Contexts I,
                                    Programs = Programs I, ODEs = ODEs I, ODEBV = ODEBV I⦈
                                 (args i) ν)
                          (χ ia. extendf_deriv I i (args ia) ν x b)))"
          using eq apply simp by presburger
        qed
    by simp
next
  case (4 θ⇩₁ θ⇩₂)
  assume free1:"dfree θ⇩₁"
  assume free2:"dfree θ⇩₂"
  assume IH1:"continuous_on UNIV (λx. Blinfun (extendf_deriv I i θ⇩₁ ν x))"
  assume IH2:"continuous_on UNIV (λx. Blinfun (extendf_deriv I i θ⇩₂ ν x))"
  have bound:"⋀x. bounded_linear  (λa. extendf_deriv I i θ⇩₁ ν x a + extendf_deriv I i θ⇩₂ ν x a)"
    using extendf_deriv_bounded[OF free1 good_interp] extendf_deriv_bounded[OF free2 good_interp]
    by (simp add: bounded_linear_add)
  have eq:"(λx. Blinfun (λa. extendf_deriv I i θ⇩₁ ν x a + extendf_deriv I i θ⇩₂ ν x a)) = (λx. Blinfun (λa. extendf_deriv I i θ⇩₁ ν x a) + Blinfun (λa. extendf_deriv I i θ⇩₂ ν x a))"
    apply(rule ext)
    apply(rule blinfun_eqI)
    subgoal for x j
      using bound[of x] extendf_deriv_bounded[OF free1 good_interp] 
      extendf_deriv_bounded[OF free2 good_interp] 
      blinfun.add_left[of "Blinfun (extendf_deriv I i θ⇩₁ ν x)" "Blinfun (extendf_deriv I i θ⇩₂ ν x)"]
      bounded_linear_Blinfun_apply[of "(extendf_deriv I i θ⇩₁ ν x)"]
      bounded_linear_Blinfun_apply[of "(extendf_deriv I i θ⇩₂ ν x)"]
      by (simp add: bounded_linear_Blinfun_apply)
    done
  have "continuous_on UNIV (λx. Blinfun (λa. extendf_deriv I i θ⇩₁ ν x a) + Blinfun (λa. extendf_deriv I i θ⇩₂ ν x a))"
    apply(rule continuous_intros)
    using IH1 IH2 by auto
  then show ?case
    apply simp
    using eq by presburger
next
  case (5 θ⇩₁ θ⇩₂)
  assume free1:"dfree θ⇩₁"
  assume free2:"dfree θ⇩₂"
  assume IH1:"continuous_on UNIV (λx. Blinfun (extendf_deriv I i θ⇩₁ ν x))"
  assume IH2:"continuous_on UNIV (λx. Blinfun (extendf_deriv I i θ⇩₂ ν x))"
  have bounded:"⋀x. bounded_linear (λa. dterm_sem (extendf I x) θ⇩₁ ν * extendf_deriv I i θ⇩₂ ν x a +
                       extendf_deriv I i θ⇩₁ ν x a * dterm_sem (extendf I x) θ⇩₂ ν)"
    using extendf_deriv_bounded[OF free1 good_interp] extendf_deriv_bounded[OF free2 good_interp]
    by (simp add: bounded_linear_add bounded_linear_const_mult bounded_linear_mult_const)
  have eq:"(λx. Blinfun (λa. dterm_sem (extendf I x) θ⇩₁ ν * extendf_deriv I i θ⇩₂ ν x a +
                       extendf_deriv I i θ⇩₁ ν x a * dterm_sem (extendf I x) θ⇩₂ ν)) = 
           (λx. dterm_sem (extendf I x) θ⇩₁ ν *⇩_R Blinfun (λa. extendf_deriv I i θ⇩₂ ν x a) +
           dterm_sem (extendf I x) θ⇩₂ ν *⇩_R Blinfun (λa. extendf_deriv I i θ⇩₁ ν x a))"
    apply(rule ext)
    apply(rule blinfun_eqI)
    subgoal for x j
      using extendf_deriv_bounded[OF free1 good_interp] extendf_deriv_bounded[OF free2 good_interp] bounded[of x]
      blinfun.scaleR_left 
      bounded_linear_Blinfun_apply[of "Blinfun (extendf_deriv I i θ⇩₂ ν x)"]
      bounded_linear_Blinfun_apply[of "Blinfun (extendf_deriv I i θ⇩₁ ν x)"]
      mult.commute 
      plus_blinfun.rep_eq[of "dterm_sem (extendf I x) θ⇩₁ ν *⇩_R Blinfun (extendf_deriv I i θ⇩₂ ν x)" "dterm_sem (extendf I x) θ⇩₂ ν *⇩_R Blinfun (extendf_deriv I i θ⇩₁ ν x)"]
      real_scaleR_def
      by (simp add: blinfun.scaleR_left bounded_linear_Blinfun_apply)
    done
  have "continuous_on UNIV (λx. dterm_sem (extendf I x) θ⇩₁ ν *⇩_R Blinfun (λa. extendf_deriv I i θ⇩₂ ν x a) +
           dterm_sem (extendf I x) θ⇩₂ ν *⇩_R Blinfun (λa. extendf_deriv I i θ⇩₁ ν x a))"
    apply(rule continuous_intros)+
      apply(rule extendf_dterm_sem_continuous[OF free1 good_interp])
     apply(rule IH2)
    apply(rule continuous_intros)+
     apply(rule extendf_dterm_sem_continuous[OF free2 good_interp])
    by(rule IH1)
  then show ?case
    unfolding extendf_deriv.simps
    using eq by presburger
qed (auto intro: continuous_intros)
  
lemma extendf_deriv:
  fixes f'::"('sf + 'sz,'sz) trm" and I::"('sf,'sc,'sz) interp"
  assumes free:"dfree f'"
  assumes good_interp:"is_interp I"
  shows "∃f''. ∀x. ((λR. dterm_sem (extendf I R) f' ν) has_derivative (extendf_deriv I i_f f' ν x)) (at x)"
  using free apply (induction rule: dfree.induct)
  apply(auto)+
   defer
   subgoal for θ⇩₁ θ⇩₂ x
     apply(rule has_derivative_mult)
      by auto
   subgoal for args i x
     apply(cases "i")
      defer
      apply auto
      subgoal for b using has_derivative_proj' by blast
     subgoal for a
   proof -
     assume dfrees:"(⋀i. dfree (args i))"
     assume IH1:"(⋀ia. ∀x. ((λR. dterm_sem
                      ⦇Functions = case_sum (Functions I) (λf' _. R $ f'), Predicates = Predicates I, Contexts = Contexts I, Programs = Programs I,
                         ODEs = ODEs I, ODEBV = ODEBV I⦈
                      (args ia) ν) has_derivative
                extendf_deriv I i_f (args ia) ν x)
                (at x))"
     then have IH1':"(⋀ia. ⋀x. ((λR. dterm_sem
                      ⦇Functions = case_sum (Functions I) (λf' _. R $ f'), Predicates = Predicates I, Contexts = Contexts I, Programs = Programs I,
                         ODEs = ODEs I, ODEBV = ODEBV I⦈
                      (args ia) ν) has_derivative
                extendf_deriv I i_f (args ia) ν x)
                (at x))"
       by auto
     assume a:"i = Inl a"
     have chain:"⋀f f' x s g g'. (f has_derivative f') (at x within s) ⟹
      (g has_derivative g') (at (f x) within f ` s) ⟹ (g ∘ f has_derivative g' ∘ f') (at x within s)"
       by (auto intro: derivative_intros)
     let ?f = "(λx. Functions I a x)"
     let ?g = "(λ R. (χ i. dterm_sem
                       ⦇Functions = case_sum (Functions I) (λf' _. R $ f'), Predicates = Predicates I, Contexts = Contexts I,
                          Programs = Programs I, ODEs = ODEs I, ODEBV = ODEBV I⦈
                       (args i) ν))"
     let ?myf' = "(λx. (THE f'. ∀y. (Functions I a has_derivative f' y) (at y)) (?g x))"
     let ?myg' = "(λx. (λν'. χ ia. extendf_deriv I i_f (args ia) ν x ν'))"
     have fg_eq:"(λR. Functions I a
           (χ i. dterm_sem
                  ⦇Functions = case_sum (Functions I) (λf' _. R $ f'), Predicates = Predicates I, Contexts = Contexts I, Programs = Programs I,
                     ODEs = ODEs I, ODEBV = ODEBV I⦈
                  (args i) ν)) = (?f ∘ ?g)"
       by auto
     have "∀x. ((?f o ?g) has_derivative (?myf' x ∘ ?myg' x)) (at x)"
       apply (rule allI)
       apply (rule diff_chain_at)
       subgoal for xa
         apply (rule has_derivative_vec)
         subgoal for i using IH1'[of i xa] by auto
         done
       subgoal for xa 
       proof -
         have deriv:"⋀x. (Functions I a has_derivative FunctionFrechet I a x) (at x)"
         and cont:"continuous_on UNIV (λx. Blinfun (FunctionFrechet I a x))"
           using good_interp[unfolded is_interp_def] by auto
         show ?thesis
           apply(rule has_derivative_at_withinI)
           using deriv by auto
       qed
      done
    then have "((?f o ?g) has_derivative (?myf' x ∘ ?myg' x)) (at x)" by auto
    then show "((λR. Functions I a
           (χ i. dterm_sem
                  ⦇Functions = case_sum (Functions I) (λf' _. R $ f'), Predicates = Predicates I, Contexts = Contexts I, Programs = Programs I,
                     ODEs = ODEs I, ODEBV = ODEBV I⦈
                  (args i) ν)) has_derivative
              (THE f'. ∀y. (Functions I a has_derivative f' y) (at y))
      (χ i. dterm_sem
             ⦇Functions = case_sum (Functions I) (λf' _. x $ f'), Predicates = Predicates I, Contexts = Contexts I, Programs = Programs I,
                ODEs = ODEs I, ODEBV = ODEBV I⦈
             (args i) ν) ∘
     (λν'. χ ia. extendf_deriv I i_f (args ia) ν x ν'))
     (at x) "
      using fg_eq by auto
  qed
  done
done

lemma adjoint_safe:
  assumes good_interp:"is_interp I"
  assumes good_subst:"(⋀i f'. SFunctions σ i = Some f' ⟹ dfree f') "    
  shows "is_interp (adjoint I σ ν)"
  apply(unfold adjoint_def)
  apply(unfold is_interp_def)
  apply(auto simp del: extendf.simps extendc.simps FunctionFrechet.simps)
   subgoal for x i
     apply(cases "SFunctions σ i = None")
      subgoal
        apply(auto simp del: extendf.simps extendc.simps)
        using good_interp unfolding is_interp_def by simp
      apply(auto  simp del: extendf.simps extendc.simps)
      subgoal for f'
        using good_subst[of i f'] apply (auto  simp del: extendf.simps extendc.simps)
      proof -
        assume some:"SFunctions σ i = Some f'"
        assume free:"dfree f'"
        let ?f = "(λR. dterm_sem (extendf I R) f' ν)"
        let ?Pred = "(λfd. (∀x. (?f has_derivative (fd x)) (at x)))"
        let ?f''="extendf_deriv I i f' ν"
        have Pf:"?Pred ?f''"
          using extendf_deriv[OF good_subst[of i f'] good_interp, of ν i, OF some]
          by auto
        have "(THE G. (?f has_derivative G) (at x)) = ?f'' x"
          apply(rule the_deriv)
          using Pf by auto
        then have the_eq:"(THE G. ∀ x. (?f has_derivative G x) (at x)) = ?f''"
          using Pf the_all_deriv by auto
        show "((λR. dterm_sem (extendf I R) f' ν) has_derivative (THE f'a. ∀x. ((λR. dterm_sem (extendf I R) f' ν) has_derivative f'a x) (at x)) x) (at x)"
          using the_eq Pf by simp
      qed
      done
    subgoal for i
      apply(cases "SFunctions σ i = None")
       subgoal
         apply(auto  simp del: extendf.simps extendc.simps)
         using good_interp unfolding is_interp_def by simp
      apply(auto  simp del: extendf.simps extendc.simps)
      subgoal for f'
        using good_subst[of i f'] apply (auto  simp del: extendf.simps extendc.simps)
      proof -
        assume some:"SFunctions σ i = Some f'"
        assume free:"dfree f'"
        let ?f = "(λR. dterm_sem (extendf I R) f' ν)"
        let ?Pred = "(λfd. (∀x. (?f has_derivative (fd x)) (at x)))"
        let ?f''="extendf_deriv I i f' ν"
        have Pf:"?Pred ?f''"
          using extendf_deriv[OF good_subst[of i f'] good_interp, of ν i, OF some]
          by auto
        have "⋀x. (THE G. (?f has_derivative G) (at x)) = ?f'' x"
          apply(rule the_deriv)
          using Pf by auto
        then have the_eq:"(THE G. ∀ x. (?f has_derivative G x) (at x)) = ?f''"
          using Pf the_all_deriv by auto
        have "continuous_on UNIV (λx. Blinfun (?f'' x))"
          by(rule extendf_deriv_continuous[OF free good_interp])
        show "continuous_on UNIV (λx. Blinfun ((THE f'a. ∀x. ((λR. dterm_sem (extendf I R) f' ν) has_derivative f'a x) (at x)) x))"
          using the_eq Pf 
          by (simp add: ‹continuous_on UNIV (λx. Blinfun (extendf_deriv I i f' ν x))›)
      qed
    done
  done

lemma adjointFO_safe:
  assumes good_interp:"is_interp I"
  assumes good_subst:"(⋀i. dsafe (σ i))"
  shows "is_interp (adjointFO I σ ν)"
  apply(unfold adjointFO_def)
  apply(unfold is_interp_def)
  apply(auto simp del: extendf.simps extendc.simps FunctionFrechet.simps)
   subgoal for x i
     apply(cases "i")
      subgoal
        apply(auto  simp del: extendf.simps extendc.simps)
        using good_interp unfolding is_interp_def by simp
     apply(auto  simp del: extendf.simps extendc.simps)
     subgoal for f'
     proof -
       assume some:"i = Inr f'"
       have free:"dsafe (σ f')" using good_subst by auto
       let ?f = "(λ_. dterm_sem I (σ f') ν)"
       let ?Pred = "(λfd. (∀x. (?f has_derivative (fd x)) (at x)))"
       let ?f''="(λ_ _. 0)"
       have Pf:"?Pred ?f''"
       proof (induction "σ f'")
       qed (auto)
       have "(THE G. (?f has_derivative G) (at x)) = ?f'' x"
         apply(rule the_deriv)
         using Pf by auto
       then have the_eq:"(THE G. ∀ x. (?f has_derivative G x) (at x)) = ?f''"
         using Pf the_all_deriv[of ?f ?f''] by auto
       have another_eq:"(THE f'a. ∀x. ((λ_. dterm_sem I (σ f') ν) has_derivative f'a x) (at x)) x = (λ _. 0)"
         using Pf by (simp add: the_eq) 
       then show "((λ_. dterm_sem I (σ f') ν) has_derivative (THE f'a. ∀x. ((λ_. dterm_sem I (σ f') ν) has_derivative f'a x) (at x)) x) (at x)"
         using the_eq Pf by simp
       qed
    done
  subgoal for i
    apply(cases i)
     subgoal
       apply(auto  simp del: extendf.simps extendc.simps)
       using good_interp unfolding is_interp_def by simp
    apply(auto  simp del: extendf.simps extendc.simps)
    subgoal for f'
      using good_subst[of f'] 
    proof -
      assume some:"i = Inr f'"
      have free:"dsafe (σ f')" using good_subst by auto
      let ?f = "(λR. dterm_sem I (σ f') ν)"
      let ?Pred = "(λfd. (∀x. (?f has_derivative (fd x)) (at x)))"
      let ?f''="(λ_ _. 0)" (* *)
      have Pf:"?Pred ?f''" by simp
      have "⋀x. (THE G. (?f has_derivative G) (at x)) = ?f'' x"
        apply(rule the_deriv)
        using Pf by auto
      then have the_eq:"(THE G. ∀ x. (?f has_derivative G x) (at x)) = ?f''"
        using Pf the_all_deriv[of "(λR. dterm_sem I (σ f') ν)" "(λ_ _. 0)"]
        by blast
      then have blin_cont:"continuous_on UNIV (λx. Blinfun (?f'' x))"
        by (simp add: continuous_on_const)
      have truth:"(λx. Blinfun ((THE f'a. ∀x. ((λ_. dterm_sem I (σ f') ν) has_derivative f'a x) (at x)) x))
        = (λx. Blinfun (λ _. 0))"
        apply(rule ext)
        apply(rule blinfun_eqI)
        by (simp add: local.the_eq)
      then show "continuous_on UNIV (λx. Blinfun ((THE f'a. ∀x. ((λ_. dterm_sem I (σ f') ν) has_derivative f'a x) (at x)) x))"
        using truth 
        by (metis (mono_tags, lifting) blin_cont continuous_on_eq)
      qed
    done
  done

subsection ‹Lemmas about adjoint interpretations›
lemma adjoint_consequence:"(⋀f f'. SFunctions σ f = Some f' ⟹ dsafe f') ⟹ (⋀f f'. SPredicates σ f = Some f' ⟹ fsafe f') ⟹ Vagree ν ω (FVS σ) ⟹ adjoint I σ ν = adjoint I σ ω"
  apply(unfold FVS_def)
  apply(auto)
  apply(unfold adjoint_def)
  apply(rule interp_eq)
       apply(auto simp add: fun_eq_iff)
    subgoal for xa xaa 
      apply(cases "SFunctions σ xa")
       apply(auto)
      subgoal for a 
      proof -
        assume safes:"(⋀f f'. SFunctions σ f = Some f' ⟹ dsafe f')"
        assume agrees:"Vagree ν ω (⋃x. SFV σ x)"
        assume some:"SFunctions σ xa = Some a"
        from safes some have safe:"dsafe a" by auto
        have sub:"SFV σ (Inl xa) ⊆ (⋃x. SFV σ x)"
          by blast
        from agrees 
        have "Vagree ν ω (SFV σ (Inl xa))"
          using agree_sub[OF sub agrees] by auto
        then have agree:"Vagree ν ω (FVT a)"
          using some by auto
        show "?thesis"
          using coincidence_dterm[of a, OF safes[of xa a, OF some] agree] by auto
      qed
    done
   subgoal for xa xaa 
    apply(cases "SPredicates σ xa")
     apply(auto)
    subgoal for a 
    proof -
      assume safes:"(⋀f f'. SPredicates σ f = Some f' ⟹ fsafe f')"
      assume agrees:"Vagree ν ω (⋃x. SFV σ x)"
      assume some:"SPredicates σ xa = Some a"
      assume sem:"ν ∈ fml_sem ⦇Functions = case_sum (Functions I) (λf' _. xaa $ f'), Predicates = Predicates I, Contexts = Contexts I, Programs = Programs I,
                  ODEs = ODEs I, ODEBV = ODEBV I⦈
        a"
      from safes some have safe:"fsafe a" by auto
      have sub:"SFV σ (Inr (Inr xa)) ⊆ (⋃x. SFV σ x)"
        by blast
      from agrees 
      have "Vagree ν ω (SFV σ (Inr (Inr xa)))"
        using agree_sub[OF sub agrees] by auto
      then have agree:"Vagree ν ω (FVF a)"
        using some by auto
      let ?I' = "⦇Functions = case_sum (Functions I) (λf' _. xaa $ f'), Predicates = Predicates I, Contexts = Contexts I, Programs = Programs I,
                  ODEs = ODEs I, ODEBV = ODEBV I⦈"
      have IA:"⋀S. Iagree ?I' ?I' (SIGF a)" using Iagree_refl by auto
      show "?thesis"
        using coincidence_formula[of a, OF safes[of xa a, OF some] IA agree] sem by auto
    qed
    done
   subgoal for xa xaa 
    apply(cases "SPredicates σ xa")
     apply(auto)
    subgoal for a 
    proof -
      assume safes:"(⋀f f'. SPredicates σ f = Some f' ⟹ fsafe f')"
      assume agrees:"Vagree ν ω (⋃x. SFV σ x)"
      assume some:"SPredicates σ xa = Some a"
      assume sem:"ω ∈ fml_sem ⦇Functions = case_sum (Functions I) (λf' _. xaa $ f'), Predicates = Predicates I, Contexts = Contexts I, Programs = Programs I,
                  ODEs = ODEs I, ODEBV = ODEBV I⦈
        a"
      from safes some have safe:"fsafe a" by auto
      have sub:"SFV σ (Inr (Inr xa)) ⊆ (⋃x. SFV σ x)"
        by blast
      from agrees 
      have "Vagree ν ω (SFV σ (Inr (Inr xa)))"
        using agree_sub[OF sub agrees] by auto
      then have agree:"Vagree ν ω (FVF a)"
        using some by auto
      let ?I' = "⦇Functions = case_sum (Functions I) (λf' _. xaa $ f'), Predicates = Predicates I, Contexts = Contexts I, Programs = Programs I,
                  ODEs = ODEs I, ODEBV = ODEBV I⦈"
      have IA:"⋀S. Iagree ?I' ?I' (SIGF a)" using Iagree_refl by auto
      show "?thesis"
        using coincidence_formula[of a, OF safes[of xa a, OF some] IA agree] sem by auto
    qed
  done    
done

lemma SIGT_plus1:"Vagree ν ω (⋃i∈SIGT (Plus t1 t2). case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {}) 
  ⟹ Vagree ν ω (⋃i∈SIGT t1. case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {})"
  unfolding Vagree_def by auto

lemma SIGT_plus2:"Vagree ν ω (⋃i∈SIGT (Plus t1 t2). case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {}) 
  ⟹ Vagree ν ω (⋃i∈SIGT t2. case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {})"
  unfolding Vagree_def by auto

lemma SIGT_times1:"Vagree ν ω (⋃i∈SIGT (Times t1 t2). case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {}) 
  ⟹ Vagree ν ω (⋃i∈SIGT t1. case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {})"
  unfolding Vagree_def by auto

lemma SIGT_times2:"Vagree ν ω (⋃i∈SIGT (Times t1 t2). case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {}) 
  ⟹ Vagree ν ω (⋃i∈SIGT t2. case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {})"
  unfolding Vagree_def by auto

lemma uadmit_sterm_adjoint':
  assumes dsafe:"⋀f f'. SFunctions σ f = Some f' ⟹ dsafe f'"
  assumes fsafe:"⋀f f'. SPredicates σ f = Some f' ⟹ fsafe f'"
  shows  "Vagree ν ω (⋃i∈SIGT θ. case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {}) ⟹ sterm_sem (adjoint I σ ν) θ = sterm_sem (adjoint I σ ω) θ"
proof (induct "θ")
  case (Plus θ1 θ2)
  assume IH1:"Vagree ν ω (⋃i∈SIGT θ1. case SFunctions σ i of Some a ⇒ FVT a | None ⇒ {}) ⟹ sterm_sem (local.adjoint I σ ν) θ1 = sterm_sem (local.adjoint I σ ω) θ1"
  assume IH2:"Vagree ν ω (⋃i∈SIGT θ2. case SFunctions σ i of Some a ⇒ FVT a | None ⇒ {}) ⟹ sterm_sem (local.adjoint I σ ν) θ2 = sterm_sem (local.adjoint I σ ω) θ2"
  assume VA:"Vagree ν ω (⋃i∈SIGT (Plus θ1 θ2). case SFunctions σ i of Some a ⇒ FVT a | None ⇒ {})"
  then show ?case
    using IH1[OF SIGT_plus1[OF VA]] IH2[OF SIGT_plus2[OF VA]] by auto
next
  case (Times θ1 θ2)
  assume IH1:"Vagree ν ω (⋃i∈SIGT θ1. case SFunctions σ i of Some a ⇒ FVT a | None ⇒ {}) ⟹ sterm_sem (local.adjoint I σ ν) θ1 = sterm_sem (local.adjoint I σ ω) θ1"
  assume IH2:"Vagree ν ω (⋃i∈SIGT θ2. case SFunctions σ i of Some a ⇒ FVT a | None ⇒ {}) ⟹ sterm_sem (local.adjoint I σ ν) θ2 = sterm_sem (local.adjoint I σ ω) θ2"
  assume VA:"Vagree ν ω (⋃i∈SIGT (Times θ1 θ2). case SFunctions σ i of Some a ⇒ FVT a | None ⇒ {})"    
  then show ?case
    using IH1[OF SIGT_times1[OF VA]] IH2[OF SIGT_times2[OF VA]] by auto
next
  case (Function x1a x2a)
  assume IH:"⋀x. x ∈ range x2a ⟹ Vagree ν ω (⋃i∈SIGT x. case SFunctions σ i of Some a ⇒ FVT a | None ⇒ {}) ⟹
    sterm_sem (local.adjoint I σ ν) x = sterm_sem (local.adjoint I σ ω) x"
  from IH have IH':"⋀j. Vagree ν ω (⋃i∈SIGT (x2a j). case SFunctions σ i of Some a ⇒ FVT a | None ⇒ {}) ⟹
    sterm_sem (local.adjoint I σ ν) (x2a j) = sterm_sem (local.adjoint I σ ω) (x2a j)"
    using rangeI by auto
  assume VA:"Vagree ν ω (⋃i∈SIGT ($f x1a x2a). case SFunctions σ i of Some a ⇒ FVT a | None ⇒ {})"
  from VA have VAs:"⋀j. Vagree ν ω (⋃i∈SIGT (x2a j). case SFunctions σ i of Some a ⇒ FVT a | None ⇒ {})"
    unfolding Vagree_def SIGT.simps using rangeI by blast
  have SIGT:"x1a ∈ SIGT ($f x1a x2a)" by auto
  have VAsub:"⋀a. SFunctions σ x1a = Some a ⟹ (FVT a) ⊆ (⋃i∈SIGT ($f x1a x2a). case SFunctions σ i of Some a ⇒ FVT a | None ⇒ {})"
    using SIGT by auto
  have VAf:"⋀a. SFunctions σ x1a = Some a ⟹ Vagree ν ω (FVT a)"
    using agree_sub[OF VAsub VA] by auto
  then show ?case 
    using IH'[OF VAs] apply (auto simp add: fun_eq_iff)
    apply(cases "SFunctions σ x1a")
     defer
     subgoal for x a
     proof -
       assume VA:"(⋀a. SFunctions σ x1a = Some a ⟹ Vagree ν ω (FVT a))"
       assume sems:"(⋀j. ∀x. sterm_sem (local.adjoint I σ ν) (x2a j) x = sterm_sem (local.adjoint I σ ω) (x2a j) x)"
       assume some:"SFunctions σ x1a = Some a"
       note FVT = VAf[OF some]
       have dsem:"⋀R . dterm_sem (extendf I R) a ν = dterm_sem (extendf I R) a ω"
         using coincidence_dterm[OF dsafe[OF some] FVT] by auto
       have "⋀R. Functions (local.adjoint I σ ν) x1a R = Functions (local.adjoint I σ ω) x1a R"
         using dsem some unfolding adjoint_def by auto
       then show "Functions (local.adjoint I σ ν) x1a (χ i. sterm_sem (local.adjoint I σ ω) (x2a i) x) =
                 Functions (local.adjoint I σ ω) x1a (χ i. sterm_sem (local.adjoint I σ ω) (x2a i) x)"
         by auto
     qed
    unfolding adjoint_def apply auto    
    done
qed (auto)  
  
― ‹Not used, but good practice for ‹dterm› adjoint›
lemma uadmit_sterm_adjoint:
  assumes TUA:"TUadmit σ θ U"
  assumes VA:"Vagree ν ω (-U)"
  assumes dsafe:"⋀f f'. SFunctions σ f = Some f' ⟹ dsafe f'"
  assumes fsafe:"⋀f f'. SPredicates σ f = Some f' ⟹ fsafe f'"
  shows  "sterm_sem (adjoint I σ ν) θ = sterm_sem (adjoint I σ ω) θ"
proof -
  have duh:"⋀A B. A ∩ B = {} ⟹ A ⊆ -B"
    by auto
  have "⋀x. x ∈ (⋃i∈SIGT θ. case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {}) ⟹ x ∈ (-U)"
    using TUA unfolding TUadmit_def by auto
  then have sub1:"(⋃i∈SIGT θ. case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {}) ⊆ -U"
    by auto
  then have VA':"Vagree ν ω (⋃i∈SIGT θ. case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {})"
    using agree_sub[OF sub1 VA] by auto
  then show "?thesis" using uadmit_sterm_adjoint'[OF dsafe fsafe VA'] by auto
qed

lemma uadmit_sterm_ntadjoint':
  assumes dsafe:"⋀i. dsafe (σ i)"
  shows  "Vagree ν ω ((⋃ i∈{i. Inr i ∈ SIGT θ}. FVT (σ i))) ⟹ sterm_sem (adjointFO I σ ν) θ = sterm_sem (adjointFO I σ ω) θ"
proof (induct "θ")
  case (Plus θ1 θ2)
  assume IH1:"Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT θ1}. FVT (σ i)) ⟹ sterm_sem (adjointFO I σ ν) θ1 = sterm_sem (adjointFO I σ ω) θ1"
  assume IH2:"Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT θ2}. FVT (σ i)) ⟹ sterm_sem (adjointFO I σ ν) θ2 = sterm_sem (adjointFO I σ ω) θ2"
  assume VA:"Vagree ν ω ((⋃ i∈{i. Inr i ∈ SIGT (Plus θ1 θ2)}. FVT (σ i)))"
  from VA 
    have VA1:"Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT θ1}. FVT (σ i))"
    and  VA2:"Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT θ2}. FVT (σ i))" unfolding Vagree_def by auto
  then show ?case
    using IH1[OF VA1] IH2[OF VA2] by auto
next
  case (Times θ1 θ2)
  assume IH1:"Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT θ1}. FVT (σ i)) ⟹ sterm_sem (adjointFO I σ ν) θ1 = sterm_sem (adjointFO I σ ω) θ1"
  assume IH2:"Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT θ2}. FVT (σ i)) ⟹ sterm_sem (adjointFO I σ ν) θ2 = sterm_sem (adjointFO I σ ω) θ2"
  assume VA:"Vagree ν ω ((⋃ i∈{i. Inr i ∈ SIGT (Times θ1 θ2)}. FVT (σ i)))"
  from VA 
  have VA1:"Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT θ1}. FVT (σ i))"
  and  VA2:"Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT θ2}. FVT (σ i))" unfolding Vagree_def by auto
  then show ?case
    using IH1[OF VA1] IH2[OF VA2] by auto
next
  case (Function x1a x2a) 
  assume IH:"⋀x. x ∈ range x2a ⟹ Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT x}. FVT (σ i)) ⟹
    sterm_sem (adjointFO I σ ν) x = sterm_sem (adjointFO I σ ω) x"
  from IH have IH':"⋀j. Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT (x2a j)}. FVT (σ i)) ⟹
    sterm_sem (adjointFO I σ ν) (x2a j) = sterm_sem (adjointFO I σ ω) (x2a j)"
    using rangeI by auto
  assume VA:"Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT ($f x1a x2a)}. FVT (σ i)) "
  from VA have VAs:"⋀j. Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT (x2a j)}. FVT (σ i))"
    unfolding Vagree_def SIGT.simps using rangeI by blast
  have SIGT:"x1a ∈ SIGT ($f x1a x2a)" by auto
  have VAsub:"⋀a. x1a = Inr a ⟹ (FVT (σ a)) ⊆ (⋃ i∈{i. Inr i ∈ SIGT ($f x1a x2a)}. FVT (σ i))"
    using SIGT by auto
  have VAf:"⋀a. x1a = Inr a ⟹Vagree ν ω (FVT (σ a))"
    using agree_sub[OF VAsub VA] by auto
  then show ?case 
    using IH'[OF VAs] apply (auto simp add: fun_eq_iff)
    apply(cases "x1a")
     defer
     subgoal for x a
     proof -
       assume VA:"(⋀a.  x1a = Inr a ⟹ Vagree ν ω (FVT (σ a)))"
       assume sems:"(⋀j. ∀x. sterm_sem (adjointFO I σ ν) (x2a j) x = sterm_sem (adjointFO I σ ω) (x2a j) x)"
       assume some:"x1a = Inr a"
       note FVT = VAf[OF some]
       from dsafe have dsafer:"⋀i. dsafe (σ i)" using dfree_is_dsafe by auto
       have dsem:"dterm_sem I (σ a) ν = dterm_sem I (σ a) ω"
         using coincidence_dterm[OF dsafer FVT] some by auto
       then have "⋀R. Functions (adjointFO I σ ν) x1a R = Functions (adjointFO I σ ω) x1a R"
         using some unfolding adjoint_def unfolding adjointFO_def by auto
       then show "Functions (adjointFO I σ ν) x1a (χ i. sterm_sem (adjointFO I σ ω) (x2a i) x) =
                  Functions (adjointFO I σ ω) x1a (χ i. sterm_sem (adjointFO I σ ω) (x2a i) x)"
         by auto
     qed
    unfolding adjointFO_def by auto
qed (auto) 
  
lemma uadmit_sterm_ntadjoint:
  assumes TUA:"NTUadmit σ θ U"
  assumes VA:"Vagree ν ω (-U)"
  assumes dsafe:"⋀i . dsafe (σ i)"
  assumes good_interp:"is_interp I"
  shows  "sterm_sem (adjointFO I σ ν) θ = sterm_sem (adjointFO I σ ω) θ"
proof -
  have duh:"⋀A B. A ∩ B = {} ⟹ A ⊆ -B"
    by auto
  have "⋀x. x ∈ ((⋃ i∈{i. Inr i ∈ SIGT θ}. FVT (σ i))) ⟹ x ∈ (-U)"
    using TUA unfolding NTUadmit_def by auto
  then have sub1:"(⋃i∈{i. Inr i ∈ SIGT θ}. FVT (σ i)) ⊆ -U"
    by auto
  then have VA':"Vagree ν ω (⋃i∈{i. Inr i ∈ SIGT θ}. FVT (σ i))"
    using agree_sub[OF sub1 VA] by auto
  then show "?thesis" using uadmit_sterm_ntadjoint'[OF  dsafe VA'] by auto
qed

lemma uadmit_dterm_adjoint':
  assumes dfree:"⋀f f'. SFunctions σ f = Some f' ⟹ dfree f'"
  assumes fsafe:"⋀f f'. SPredicates σ f = Some f' ⟹ fsafe f'"
  assumes good_interp:"is_interp I"
  shows  "⋀ν ω. Vagree ν ω (⋃i∈SIGT θ. case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {}) ⟹ dsafe θ ⟹ dterm_sem (adjoint I σ ν) θ = dterm_sem (adjoint I σ ω) θ"
proof (induct "θ")
  case (Plus θ1 θ2)
  assume IH1:"⋀ν ω. Vagree ν ω (⋃i∈SIGT θ1. case SFunctions σ i of Some a ⇒ FVT a | None ⇒ {}) ⟹ dsafe θ1 ⟹ dterm_sem (local.adjoint I σ ν) θ1 = dterm_sem (local.adjoint I σ ω) θ1"
  assume IH2:"⋀ν ω. Vagree ν ω (⋃i∈SIGT θ2. case SFunctions σ i of Some a ⇒ FVT a | None ⇒ {}) ⟹ dsafe θ2 ⟹ dterm_sem (local.adjoint I σ ν) θ2 = dterm_sem (local.adjoint I σ ω) θ2"
  assume VA:"Vagree ν ω (⋃i∈SIGT (Plus θ1 θ2). case SFunctions σ i of Some a ⇒ FVT a | None ⇒ {})"
  assume safe:"dsafe (Plus θ1 θ2)"
  then show ?case
    using IH1[OF SIGT_plus1[OF VA]] IH2[OF SIGT_plus2[OF VA]] by auto
next
  case (Times θ1 θ2)
  assume IH1:"⋀ν ω. Vagree ν ω (⋃i∈SIGT θ1. case SFunctions σ i of Some a ⇒ FVT a | None ⇒ {}) ⟹ dsafe θ1 ⟹ dterm_sem (local.adjoint I σ ν) θ1 = dterm_sem (local.adjoint I σ ω) θ1"
  assume IH2:"⋀ν ω. Vagree ν ω (⋃i∈SIGT θ2. case SFunctions σ i of Some a ⇒ FVT a | None ⇒ {}) ⟹ dsafe θ2 ⟹ dterm_sem (local.adjoint I σ ν) θ2 = dterm_sem (local.adjoint I σ ω) θ2"
  assume VA:"Vagree ν ω (⋃i∈SIGT (Times θ1 θ2). case SFunctions σ i of Some a ⇒ FVT a | None ⇒ {})"
  assume safe:"dsafe (Times θ1 θ2)"
  then show ?case
    using IH1[OF SIGT_times1[OF VA]] IH2[OF SIGT_times2[OF VA]] by auto
next
  case (Function x1a x2a)
  assume IH:"⋀x. ⋀ν ω. x ∈ range x2a ⟹ Vagree ν ω (⋃i∈SIGT x. case SFunctions σ i of Some a ⇒ FVT a | None ⇒ {}) ⟹
    dsafe x ⟹ dterm_sem (local.adjoint I σ ν) x = dterm_sem (local.adjoint I σ ω) x"
  assume safe:"dsafe (Function x1a x2a)"
  from safe have safes:"⋀j. dsafe (x2a j)" by auto
  from IH have IH':"⋀j. Vagree ν ω (⋃i∈SIGT (x2a j). case SFunctions σ i of Some a ⇒ FVT a | None ⇒ {}) ⟹
    dterm_sem (local.adjoint I σ ν) (x2a j) = dterm_sem (local.adjoint I σ ω) (x2a j)"
    using rangeI safes by auto
  assume VA:"Vagree ν ω (⋃i∈SIGT ($f x1a x2a). case SFunctions σ i of Some a ⇒ FVT a | None ⇒ {})"
  from VA have VAs:"⋀j. Vagree ν ω (⋃i∈SIGT (x2a j). case SFunctions σ i of Some a ⇒ FVT a | None ⇒ {})"
    unfolding Vagree_def SIGT.simps using rangeI by blast
  have SIGT:"x1a ∈ SIGT ($f x1a x2a)" by auto
  have VAsub:"⋀a. SFunctions σ x1a = Some a ⟹ (FVT a) ⊆ (⋃i∈SIGT ($f x1a x2a). case SFunctions σ i of Some a ⇒ FVT a | None ⇒ {})"
    using SIGT by auto
  have VAf:"⋀a. SFunctions σ x1a = Some a ⟹ Vagree ν ω (FVT a)"
    using agree_sub[OF VAsub VA] by auto
  then show ?case 
    using IH'[OF VAs] apply (auto simp add: fun_eq_iff)
    apply(cases "SFunctions σ x1a")
     defer
     subgoal for x1 x2 a
     proof -
       assume VA:"(⋀a. SFunctions σ x1a = Some a ⟹ Vagree ν ω (FVT a))"
       assume sems:"(⋀j. ∀x1 x2. dterm_sem (local.adjoint I σ ν) (x2a j) (x1,x2) = dterm_sem (local.adjoint I σ ω) (x2a j) (x1,x2))"
       assume some:"SFunctions σ x1a = Some a"
       note FVT = VAf[OF some]
       have dsafe:"⋀f f'. SFunctions σ f = Some f' ⟹ dsafe f'"
         using dfree dfree_is_dsafe by auto
       have dsem:"⋀R . dterm_sem (extendf I R) a ν = dterm_sem (extendf I R) a ω"
         using coincidence_dterm[OF dsafe[OF some] FVT] by auto
       have "⋀R. Functions (local.adjoint I σ ν) x1a R = Functions (local.adjoint I σ ω) x1a R"
         using dsem some unfolding adjoint_def by auto
       then show "Functions (local.adjoint I σ ν) x1a (χ i. dterm_sem (local.adjoint I σ ω) (x2a i) (x1,x2)) =
                  Functions (local.adjoint I σ ω) x1a (χ i. dterm_sem (local.adjoint I σ ω) (x2a i) (x1,x2))"
         by auto
      qed
  unfolding adjoint_def apply auto    
  done
next
  case (Differential θ)
  assume IH:"⋀ν ω. Vagree ν ω (⋃i∈SIGT θ. case SFunctions σ i of Some a ⇒ FVT a | None ⇒ {}) ⟹ dsafe θ ⟹ dterm_sem (local.adjoint I σ ν) θ = dterm_sem (local.adjoint I σ ω) θ"
  assume VA:"Vagree ν ω (⋃i∈SIGT (Differential θ). case SFunctions σ i of Some a ⇒ FVT a | None ⇒ {})"
  assume safe:"dsafe (Differential θ)"
  then have free:"dfree θ" by (auto dest: dsafe.cases)
  from VA have VA':"Vagree ν ω (⋃i∈SIGT θ. case SFunctions σ i of Some a ⇒ FVT a | None ⇒ {})"
    by auto
  have dsafe:"⋀f f'. SFunctions σ f = Some f' ⟹ dsafe f'"
    using dfree dfree_is_dsafe by auto
  have sem:"sterm_sem (local.adjoint I σ ν) θ = sterm_sem (local.adjoint I σ ω) θ"
    using uadmit_sterm_adjoint'[OF dsafe fsafe VA', of "λ x y. x" "λ x y. x" I] by auto
  have good1:"is_interp (adjoint I σ ν)" using adjoint_safe[OF good_interp dfree] by auto
  have good2:"is_interp (adjoint I σ ω)" using adjoint_safe[OF good_interp dfree] by auto
  have frech:"frechet (local.adjoint I σ ν) θ = frechet (local.adjoint I σ ω) θ"
    apply (auto simp add: fun_eq_iff)
    subgoal for a b
      using sterm_determines_frechet [OF good1 good2 free free sem, of "(a,b)"] by auto
    done
  then show "dterm_sem (local.adjoint I σ ν) (Differential θ) = dterm_sem (local.adjoint I σ ω) (Differential θ)"
    by (auto simp add: directional_derivative_def)
qed (auto)  

lemma uadmit_dterm_adjoint:
  assumes TUA:"TUadmit σ θ U"
  assumes VA:"Vagree ν ω (-U)"
  assumes dfree:"⋀f f'. SFunctions σ f = Some f' ⟹ dfree f'"
  assumes fsafe:"⋀f f'. SPredicates σ f = Some f' ⟹  fsafe f'"
  assumes dsafe:"dsafe θ"
  assumes good_interp:"is_interp I"
  shows  "dterm_sem (adjoint I σ ν) θ = dterm_sem (adjoint I σ ω) θ"
proof -
  have duh:"⋀A B. A ∩ B = {} ⟹ A ⊆ -B"
    by auto
  have "⋀x. x ∈ (⋃i∈SIGT θ. case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {}) ⟹ x ∈ (-U)"
    using TUA unfolding TUadmit_def by auto
  then have sub1:"(⋃i∈SIGT θ. case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {}) ⊆ -U"
    by auto
  then have VA':"Vagree ν ω (⋃i∈SIGT θ. case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {})"
    using agree_sub[OF sub1 VA] by auto
  then show "?thesis" using uadmit_dterm_adjoint'[OF dfree fsafe good_interp VA' dsafe] 
    by auto
qed

lemma uadmit_dterm_ntadjoint':
  assumes dfree:"⋀i. dsafe (σ i)"
  assumes good_interp:"is_interp I"
  shows  "⋀ν ω. Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT θ}. FVT (σ i)) ⟹ dsafe θ ⟹ dterm_sem (adjointFO I σ ν) θ = dterm_sem (adjointFO I σ ω) θ"
proof (induct "θ")
  case (Plus θ1 θ2 ν ω)
  assume IH1:"⋀ν ω. Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT θ1}. FVT (σ i)) ⟹ dsafe θ1 ⟹ dterm_sem (adjointFO I σ ν) θ1 = dterm_sem (adjointFO I σ ω) θ1"
  assume IH2:"⋀ν ω. Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT θ2}. FVT (σ i)) ⟹ dsafe θ2 ⟹ dterm_sem (adjointFO I σ ν) θ2 = dterm_sem (adjointFO I σ ω) θ2"
  assume VA:"Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT (Plus θ1 θ2)}. FVT (σ i))"
  then have VA1:"Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT θ1}. FVT (σ i))"
    and VA2:"Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT θ2}. FVT (σ i))"
    unfolding Vagree_def by auto
  assume safe:"dsafe (Plus θ1 θ2)"
  show ?case 
    using IH1[OF VA1] IH2[OF VA2] safe by auto
next
  case (Times θ1 θ2 ν ω)
  assume IH1:"⋀ν ω. Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT θ1}. FVT (σ i)) ⟹ dsafe θ1 ⟹ dterm_sem (adjointFO I σ ν) θ1 = dterm_sem (adjointFO I σ ω) θ1"
  assume IH2:"⋀ν ω. Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT θ2}. FVT (σ i)) ⟹ dsafe θ2 ⟹ dterm_sem (adjointFO I σ ν) θ2 = dterm_sem (adjointFO I σ ω) θ2"
  assume VA:"Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT (Times θ1 θ2)}. FVT (σ i))"
  then have VA1:"Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT θ1}. FVT (σ i))"
    and VA2:"Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT θ2}. FVT (σ i))"
    unfolding Vagree_def by auto
  assume safe:"dsafe (Times θ1 θ2)"
  show ?case 
    using IH1[OF VA1] IH2[OF VA2] safe by auto
next
  case (Function x1a x2a)
    assume IH:"⋀x. ⋀ν ω. x ∈ range x2a ⟹ Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT x}. FVT (σ i)) ⟹
      dsafe x ⟹ dterm_sem (adjointFO I σ ν) x = dterm_sem (adjointFO I σ ω) x"
    assume safe:"dsafe (Function x1a x2a)"
    from safe have safes:"⋀j. dsafe (x2a j)" by auto
    from IH have IH':"⋀j. Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT (x2a j)}. FVT (σ i)) ⟹
      dterm_sem (adjointFO I σ ν) (x2a j) = dterm_sem (adjointFO I σ ω) (x2a j)"
      using rangeI safes by auto
    assume VA:"Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT ($f x1a x2a)}. FVT (σ i))"
    from VA have VAs:"⋀j. Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT (x2a j)}. FVT (σ i))"
      unfolding Vagree_def SIGT.simps using rangeI by blast
    have SIGT:"x1a ∈ SIGT ($f x1a x2a)" by auto
    have VAsub:"⋀a. x1a = Inr a⟹ (FVT (σ a)) ⊆ (⋃ i∈{i. Inr i ∈ SIGT ($f x1a x2a)}. FVT (σ i))"
      using SIGT by auto
    have VAf:"⋀a. x1a = Inr a ⟹ Vagree ν ω (FVT (σ a))"
      using agree_sub[OF VAsub VA] by auto
  then show ?case 
    using IH'[OF VAs] apply (auto simp add: fun_eq_iff)
    apply(cases "x1a")
     defer
     subgoal for x1 x2 a
     proof -
       assume VA:"(⋀a. x1a = Inr a ⟹ Vagree ν ω (FVT (σ a)))"
       assume sems:"(⋀j. ∀x1 x2. dterm_sem (adjointFO I σ ν) (x2a j) (x1,x2) = dterm_sem (adjointFO I σ ω) (x2a j) (x1,x2))"
       assume some:"x1a = Inr a"
       note FVT = VAf[OF some]
       have dsafe:"⋀i. dsafe (σ i)"
         using dfree dfree_is_dsafe by auto
       have dsem:"⋀R . dterm_sem I (σ a) ν = dterm_sem I (σ a) ω"
         using coincidence_dterm[OF dsafe FVT] by auto
       have "⋀R. Functions (adjointFO I σ ν) x1a R = Functions (adjointFO I σ ω) x1a R"
         using dsem some unfolding adjointFO_def by auto
       then show "Functions (adjointFO I σ ν) x1a (χ i. dterm_sem (adjointFO I σ ω) (x2a i) (x1,x2)) =
                  Functions (adjointFO I σ ω) x1a (χ i. dterm_sem (adjointFO I σ ω) (x2a i) (x1,x2))"
         by auto
     qed
    unfolding adjointFO_def apply auto    
    done
next
  case (Differential θ)
  assume IH:"⋀ν ω. Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT θ}. FVT (σ i)) ⟹ dsafe θ ⟹ dterm_sem (adjointFO I σ ν) θ = dterm_sem (adjointFO I σ ω) θ"
  assume VA:"Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT (Differential θ)}. FVT (σ i))"
  assume safe:"dsafe (Differential θ)"
  then have free:"dfree θ" by (auto dest: dsafe.cases)
  from VA have VA':"Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT θ}. FVT (σ i))"
    by auto
  have dsafe:"⋀i. dsafe (σ i)"
    using dfree dfree_is_dsafe by auto
  have sem:"sterm_sem (adjointFO I σ ν) θ = sterm_sem (adjointFO I σ ω) θ"
    using uadmit_sterm_ntadjoint'[OF dsafe  VA'] by auto
  have good1:"is_interp (adjointFO I σ ν)" using adjointFO_safe[OF good_interp dsafe, of "λi. i"] by auto
  have good2:"is_interp (adjointFO I σ ω)" using adjointFO_safe[OF good_interp dsafe, of "λi. i"] by auto
  have frech:"frechet (adjointFO I σ ν) θ = frechet (adjointFO I σ ω) θ"
    apply (auto simp add: fun_eq_iff)
    subgoal for a b
      using sterm_determines_frechet [OF good1 good2 free free sem, of "(a,b)"] by auto
    done
  then show "dterm_sem (adjointFO I σ ν) (Differential θ) = dterm_sem (adjointFO I σ ω) (Differential θ)"
    by (auto simp add: directional_derivative_def)
qed (auto)  

lemma uadmit_dterm_ntadjoint:
  assumes TUA:"NTUadmit σ θ U"
  assumes VA:"Vagree ν ω (-U)"
  assumes dfree:"⋀i . dsafe (σ i)"
  assumes dsafe:"dsafe θ"
  assumes good_interp:"is_interp I"
  shows  "dterm_sem (adjointFO I σ ν) θ = dterm_sem (adjointFO I σ ω) θ"
proof -
  have duh:"⋀A B. A ∩ B = {} ⟹ A ⊆ -B"
    by auto
  have duh:"⋀A B. A ∩ B = {} ⟹ A ⊆ -B"
    by auto
  have "⋀x. x ∈ (⋃ i∈{i. Inr i ∈ SIGT θ}. FVT (σ i)) ⟹ x ∈ (-U)"
    using TUA unfolding NTUadmit_def by auto
  then have sub1:"(⋃ i∈{i. Inr i ∈ SIGT θ}. FVT (σ i)) ⊆ -U"
    by auto
  then have VA':"Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT θ}. FVT (σ i))"
    using agree_sub[OF sub1 VA] by auto
  then show "?thesis" using uadmit_dterm_ntadjoint'[OF dfree good_interp VA' dsafe] 
    by auto
qed

definition ssafe ::"('sf, 'sc, 'sz) subst ⇒ bool"
where "ssafe σ ≡
  (∀ i f'. SFunctions σ i = Some f' ⟶ dfree f') ∧ 
  (∀ f f'. SPredicates σ f = Some f'  ⟶ fsafe f') ∧
  (∀ f f'. SPrograms σ f = Some f'  ⟶ hpsafe f') ∧
  (∀ f f'. SODEs σ f = Some f'  ⟶ osafe f') ∧
  (∀ C C'. SContexts σ C = Some C'  ⟶ fsafe C')"

lemma uadmit_dterm_adjointS:
  assumes ssafe:"ssafe σ"
  assumes good_interp:"is_interp I"
  fixes ν ω
  assumes VA:"Vagree ν ω (⋃i∈SIGT θ. case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {})"
  assumes dsafe:"dsafe θ"
  shows  "dterm_sem (adjoint I σ ν) θ = dterm_sem (adjoint I σ ω) θ"
proof -
  show "?thesis" 
    apply(rule uadmit_dterm_adjoint')
    using good_interp ssafe VA dsafe unfolding ssafe_def by auto 
qed

lemma adj_sub_assign_fact:"⋀i j e. i∈SIGT e ⟹ j ∈ (case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {}) ⟹ Inl i ∈({Inl x |x. x ∈ dom (SFunctions σ)} ∪ {Inr (Inl x) |x. x ∈ dom (SContexts σ)} ∪ {Inr (Inr x) |x. x ∈ dom (SPredicates σ)} ∪
         {Inr (Inr x) |x. x ∈ dom (SPrograms σ)}) ∩
        {Inl x |x. x ∈ SIGT e}"
  unfolding SDom_def apply auto
  subgoal for i j
    apply (cases "SFunctions σ i")
     by auto
  done

lemma adj_sub_geq1_fact:"⋀i j x1 x2. i∈SIGT x1 ⟹ j ∈ (case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {}) ⟹ Inl i ∈({Inl x |x. x ∈ dom (SFunctions σ)} ∪ {Inr (Inl x) |x. x ∈ dom (SContexts σ)} ∪ {Inr (Inr x) |x. x ∈ dom (SPredicates σ)} ∪
         {Inr (Inr x) |x. x ∈ dom (SPrograms σ)}) ∩
        {Inl x |x. x ∈ SIGT x1 ∨ x ∈ SIGT x2}"
  unfolding SDom_def apply auto
  subgoal for i j
    apply (cases "SFunctions σ i")
     by auto
  done

lemma adj_sub_geq2_fact:"⋀i j x1 x2. i∈SIGT x2 ⟹ j ∈ (case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {}) ⟹ Inl i ∈({Inl x |x. x ∈ dom (SFunctions σ)} ∪ {Inr (Inl x) |x. x ∈ dom (SContexts σ)} ∪ {Inr (Inr x) |x. x ∈ dom (SPredicates σ)} ∪
         {Inr (Inr x) |x. x ∈ dom (SPrograms σ)}) ∩
        {Inl x |x. x ∈ SIGT x1 ∨ x ∈ SIGT x2}"
  unfolding SDom_def apply auto
  subgoal for i j
    apply (cases "SFunctions σ i")
     by auto
  done
lemma adj_sub_prop_fact:"⋀i j x1 x2 k. i∈SIGT (x2 k) ⟹ j ∈ (case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {}) ⟹ Inl i ∈({Inl x |x. x ∈ dom (SFunctions σ)} ∪ {Inr (Inl x) |x. x ∈ dom (SContexts σ)} ∪ {Inr (Inr x) |x. x ∈ dom (SPredicates σ)} ∪
         {Inr (Inr x) |x. x ∈ dom (SPrograms σ)}) ∩
         insert (Inr (Inr x1)) {Inl x |x. ∃xa. x ∈ SIGT (x2 xa)}"
  unfolding SDom_def apply auto
  subgoal for i j
    apply (cases "SFunctions σ i")
     by auto
  done

lemma adj_sub_ode_fact:"⋀i j x1 x2. Inl i ∈ SIGO x1 ⟹ j ∈ (case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {}) ⟹ Inl i ∈({Inl x |x. x ∈ dom (SFunctions σ)} ∪ {Inr (Inl x) |x. x ∈ dom (SContexts σ)} ∪ {Inr (Inr x) |x. x ∈ dom (SPredicates σ)} ∪
         {Inr (Inr x) |x. x ∈ dom (SPrograms σ)}) ∩
         (SIGF x2 ∪ {Inl x |x. Inl x ∈ SIGO x1} ∪ {Inr (Inr x) |x. Inr x ∈ SIGO x1})"
  unfolding SDom_def apply auto
  subgoal for i j
    apply (cases "SFunctions σ i")
     by auto
  done

lemma adj_sub_assign:"⋀e σ x. (⋃i∈SIGT e. case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {}) ⊆ (⋃a∈SDom σ ∩ SIGP (x := e). SFV σ a)"
subgoal for e σ x
 unfolding SDom_def apply auto
  subgoal for i j
    apply (cases "SFunctions σ j")
     apply auto
    subgoal for a
      using adj_sub_assign_fact[of j e i]
      by (metis (mono_tags, lifting) SFV.simps(1) option.simps(5))
    done
  done
done

lemma adj_sub_diff_assign:"⋀e σ x. (⋃i∈SIGT e. case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {}) ⊆ (⋃a∈SDom σ ∩ SIGP (DiffAssign x e). SFV σ a)"
  subgoal for e σ x
    unfolding SDom_def apply auto
    subgoal for i j
      apply (cases "SFunctions σ j")
       apply auto
      subgoal for a
        using adj_sub_assign_fact[of j e i]
        by (metis (mono_tags, lifting) SFV.simps(1) option.simps(5))
      done
    done
  done
   
lemma adj_sub_geq1:"⋀σ x1 x2. (⋃i∈SIGT x1. case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {}) ⊆ (⋃a∈SDom σ ∩ SIGF (Geq x1 x2). SFV σ a)"
  subgoal for σ x1 x2
    unfolding SDom_def apply auto
    subgoal for x i
      apply (cases "SFunctions σ i")
       apply auto
      subgoal for a
        using adj_sub_geq1_fact[of i x1 x σ] 
        by (metis (mono_tags, lifting) SFV.simps(1) option.simps(5))
      done
    done
  done

lemma adj_sub_geq2:"⋀σ x1 x2. (⋃i∈SIGT x2. case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {}) ⊆ (⋃a∈SDom σ ∩ SIGF (Geq x1 x2). SFV σ a)"
  subgoal for σ x1 x2
    unfolding SDom_def apply auto
    subgoal for x i
      apply (cases "SFunctions σ i")
       apply auto
      subgoal for a
        using adj_sub_geq2_fact[of i x2 x σ] 
        by (metis (mono_tags, lifting) SFV.simps(1) option.simps(5))
      done
    done
  done

lemma adj_sub_prop:"⋀σ x1 x2 j . (⋃i∈SIGT (x2 j). case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {}) ⊆ (⋃a∈SDom σ ∩ SIGF ($φ x1 x2). SFV σ a)"
  subgoal for σ x1 x2 j
    unfolding SDom_def apply auto
    subgoal for x i
      apply (cases "SFunctions σ i")
       apply auto
      subgoal for a
        using adj_sub_prop_fact[of i x2 j x σ x1] 
        by (metis (mono_tags, lifting) SFV.simps(1) option.simps(5))     
      done
    done
  done

lemma adj_sub_ode:"⋀σ x1 x2. (⋃i∈{i |i. Inl i ∈ SIGO x1}. case SFunctions σ i of None ⇒ {} | Some x ⇒ FVT x) ⊆ (⋃a∈SDom σ ∩ SIGP (EvolveODE x1 x2). SFV σ a)"
  subgoal for σ x1 x2
    unfolding SDom_def apply auto
    subgoal for x i
      apply (cases "SFunctions σ i")
       apply auto
      subgoal for a
        using adj_sub_ode_fact[of i x1 x σ x2]
        by (metis (mono_tags, lifting) SFV.simps(1) option.simps(5)) 
     done
   done
  done

lemma uadmit_ode_adjoint':
  fixes σ I
  assumes ssafe:"ssafe σ"
  assumes good_interp:"is_interp I"
  shows"⋀ν ω. Vagree ν ω (⋃i∈{i |i. Inl i ∈ SIGO ODE}. case SFunctions σ i of None ⇒ {} | Some x ⇒ FVT x)⟹ osafe ODE ⟹ ODE_sem (adjoint I σ ν) ODE = ODE_sem (adjoint I σ ω) ODE"
proof (induction ODE)
  case (OVar x)
  then show ?case unfolding adjoint_def by auto
next
  case (OSing x1a x2)
    assume VA:"Vagree ν ω (⋃i∈{i |i. Inl i ∈ SIGO (OSing x1a x2)}. case SFunctions σ i of None ⇒ {} | Some a ⇒ FVT a)"
    assume osafe:"osafe (OSing x1a x2)"
    then have dfree:"dfree x2" by (auto dest: osafe.cases)
    have safes:"(⋀f f'. SFunctions σ f = Some f' ⟹ dsafe f')"
      "(⋀f f'. SPredicates σ f = Some f' ⟹ fsafe f')"
      using ssafe unfolding ssafe_def using dfree_is_dsafe by auto
    have sem:"sterm_sem (local.adjoint I σ ν) x2 = sterm_sem (local.adjoint I σ ω) x2"
       using uadmit_sterm_adjoint'[of σ ν ω x2 I, OF safes, of "(λ x y. x)" "(λ x y. x)"] VA
       by auto
    show ?case 
      apply auto
      apply (rule ext)
      subgoal for x
        apply (rule vec_extensionality)
        using sem by auto
      done
next
  case (OProd ODE1 ODE2)
    assume IH1:"⋀ν ω. Vagree ν ω (⋃i∈{i |i. Inl i ∈ SIGO ODE1}. case SFunctions σ i of None ⇒ {} | Some a ⇒ FVT a) ⟹
      osafe ODE1 ⟹ ODE_sem (local.adjoint I σ ν) ODE1 = ODE_sem (local.adjoint I σ ω) ODE1"
    assume IH2:"⋀ν ω. Vagree ν ω (⋃i∈{i |i. Inl i ∈ SIGO ODE2}. case SFunctions σ i of None ⇒ {} | Some a ⇒ FVT a) ⟹
    osafe ODE2 ⟹ ODE_sem (local.adjoint I σ ν) ODE2 = ODE_sem (local.adjoint I σ ω) ODE2"
    assume VA:"Vagree ν ω (⋃i∈{i |i. Inl i ∈ SIGO (OProd ODE1 ODE2)}. case SFunctions σ i of None ⇒ {} | Some a ⇒ FVT a)"
    assume safe:"osafe (OProd ODE1 ODE2)"
    from safe have safe1:"osafe ODE1" and safe2:"osafe ODE2" by (auto dest: osafe.cases) 
    have sub1:"(⋃i∈{i |i. Inl i ∈ SIGO ODE1}. case SFunctions σ i of None ⇒ {} | Some a ⇒ FVT a) ⊆ (⋃i∈{i |i. Inl i ∈ SIGO (OProd ODE1 ODE2)}. case SFunctions σ i of None ⇒ {} | Some a ⇒ FVT a)"
      by auto
    have sub2:"(⋃i∈{i |i. Inl i ∈ SIGO ODE2}. case SFunctions σ i of None ⇒ {} | Some a ⇒ FVT a) ⊆ (⋃i∈{i |i. Inl i ∈ SIGO (OProd ODE1 ODE2)}. case SFunctions σ i of None ⇒ {} | Some a ⇒ FVT a)"
      by auto
  then show ?case using IH1[OF agree_sub[OF sub1 VA] safe1] IH2[OF agree_sub[OF sub2 VA] safe2] by auto
qed

lemma uadmit_ode_ntadjoint':
  fixes σ I
  assumes ssafe:"⋀i. dsafe (σ i)"
  assumes good_interp:"is_interp I"
  shows"⋀ν ω. Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGO ODE}. FVT (σ y)) ⟹ osafe ODE ⟹ ODE_sem (adjointFO I σ ν) ODE = ODE_sem (adjointFO I σ ω) ODE"
proof (induction ODE)
  case (OVar x)
  then show ?case unfolding adjointFO_def by auto
next
  case (OSing x1a x2)
  assume VA:"Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGO (OSing x1a x2)}. FVT (σ y))"
  assume osafe:"osafe (OSing x1a x2)"
  then have dfree:"dfree x2" by (auto dest: osafe.cases)
  have sem:"sterm_sem (adjointFO I σ ν) x2 = sterm_sem (adjointFO I σ ω) x2"
     using uadmit_sterm_ntadjoint'[of σ ν ω x2 I, OF ssafe] VA
     by auto
  show ?case 
    apply auto
    apply (rule ext)
    subgoal for x
      apply (rule vec_extensionality)
      using sem by auto
    done
next
  case (OProd ODE1 ODE2)
  assume IH1:"⋀ν ω. Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGO ODE1}. FVT (σ y)) ⟹
    osafe ODE1 ⟹ ODE_sem (adjointFO I σ ν) ODE1 = ODE_sem (adjointFO I σ ω) ODE1"
  assume IH2:"⋀ν ω. Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGO ODE2}. FVT (σ y)) ⟹
    osafe ODE2 ⟹ ODE_sem (adjointFO I σ ν) ODE2 = ODE_sem (adjointFO I σ ω) ODE2"
  assume VA:"Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGO (OProd ODE1 ODE2)}. FVT (σ y))"
  assume safe:"osafe (OProd ODE1 ODE2)"
  from safe have safe1:"osafe ODE1" and safe2:"osafe ODE2" by (auto dest: osafe.cases) 
  have sub1:"(⋃y∈{y. Inl (Inr y) ∈ SIGO ODE1}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inr y) ∈ SIGO (OProd ODE1 ODE2)}. FVT (σ y))"
    by auto
  have sub2:"(⋃y∈{y. Inl (Inr y) ∈ SIGO ODE2}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inr y) ∈ SIGO (OProd ODE1 ODE2)}. FVT (σ y))"
    by auto
  then show ?case using IH1[OF agree_sub[OF sub1 VA] safe1] IH2[OF agree_sub[OF sub2 VA] safe2] by auto
qed

lemma adjoint_ode_vars:
  shows "ODE_vars (local.adjoint I σ ν) ODE = ODE_vars (local.adjoint I σ ω) ODE"
  apply(induction ODE)
  unfolding adjoint_def by auto

lemma uadmit_mkv_adjoint:
  assumes ssafe:"ssafe σ"
  assumes good_interp:"is_interp I"
  assumes VA:"Vagree ν ω (⋃i ∈ {i | i. (Inl i∈SIGO ODE)}. case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {})"
  assumes osafe:"osafe ODE"
  shows "mk_v (adjoint I σ ν) ODE = mk_v (adjoint I σ ω) ODE"
  apply(rule ext)
  subgoal for R
    apply(rule ext)
    subgoal for solt
      apply(rule agree_UNIV_eq)
      using mk_v_agree[of "(adjoint I σ ν)" ODE "R" solt]
      using mk_v_agree[of "(adjoint I σ ω)" ODE "R" solt]
      using uadmit_ode_adjoint'[OF ssafe good_interp VA osafe]
      unfolding Vagree_def
      apply auto
       subgoal for i
         apply (cases "Inl i ∈ Inl ` ODE_vars (adjoint I σ ω) ODE")
       proof -
         assume sem_eq:"ODE_sem (local.adjoint I σ ν) ODE = ODE_sem (local.adjoint I σ ω) ODE"
         have vars_eq:"ODE_vars (local.adjoint I σ ν) ODE = ODE_vars (local.adjoint I σ ω) ODE"
           apply(induction ODE)
           unfolding adjoint_def by auto
         assume thing1:" 
           ∀i. (Inl i ∈ Inl ` ODE_vars (local.adjoint I σ ν) ODE ⟶ fst (mk_v (local.adjoint I σ ν) ODE R solt) $ i = solt $ i) ∧
             (Inl i ∈ Inr ` ODE_vars (local.adjoint I σ ν) ODE ⟶ fst (mk_v (local.adjoint I σ ν) ODE R solt) $ i = solt $ i)"
         assume thing2:" 
           ∀i. (Inl i ∈ Inl ` ODE_vars (local.adjoint I σ ω) ODE ⟶ fst (mk_v (local.adjoint I σ ω) ODE R solt) $ i = solt $ i) ∧
             (Inl i ∈ Inr ` ODE_vars (local.adjoint I σ ω) ODE ⟶ fst (mk_v (local.adjoint I σ ω) ODE R solt) $ i = solt $ i)"
         assume inl:"Inl i ∈ Inl ` ODE_vars (local.adjoint I σ ω) ODE"
          from thing1 and inl have eq1: "fst (mk_v (local.adjoint I σ ν) ODE R solt) $ i = solt $ i"
            using vars_eq by auto
          from thing2 and inl have eq2: "fst (mk_v (local.adjoint I σ ω) ODE R solt) $ i = solt $ i"
            using vars_eq by auto
         show "fst (mk_v (local.adjoint I σ ν) ODE R solt) $ i = fst (mk_v (local.adjoint I σ ω) ODE R solt) $ i"
           using eq1 eq2 by auto
       next
         assume sem_eq:"ODE_sem (local.adjoint I σ ν) ODE = ODE_sem (local.adjoint I σ ω) ODE"
         assume thing1:"∀i. Inl i ∉ Inl ` ODE_vars (local.adjoint I σ ν) ODE ∧ Inl i ∉ Inr ` ODE_vars (local.adjoint I σ ν) ODE ⟶
        fst (mk_v (local.adjoint I σ ν) ODE R solt) $ i = fst R $ i"
         assume thing2:"∀i. Inl i ∉ Inl ` ODE_vars (local.adjoint I σ ω) ODE ∧ Inl i ∉ Inr ` ODE_vars (local.adjoint I σ ω) ODE ⟶
        fst (mk_v (local.adjoint I σ ω) ODE R solt) $ i = fst R $ i"
         assume inl:"Inl i ∉ Inl ` ODE_vars (local.adjoint I σ ω) ODE"
         have vars_eq:"ODE_vars (local.adjoint I σ ν) ODE = ODE_vars (local.adjoint I σ ω) ODE"
           apply(induction ODE)
             unfolding adjoint_def by auto
         from thing1 and inl have eq1: "fst (mk_v (local.adjoint I σ ν) ODE R solt) $ i = fst R $ i"
           using vars_eq by auto
         from thing2 and inl have eq2: "fst (mk_v (local.adjoint I σ ω) ODE R solt) $ i = fst R $ i"
           using vars_eq by auto
         show "fst (mk_v (local.adjoint I σ ν) ODE R solt) $ i = fst (mk_v (local.adjoint I σ ω) ODE R solt) $ i"
           using eq1 eq2 by auto
       qed
      subgoal for i
        apply (cases "Inr i ∈ Inr ` ODE_vars (adjoint I σ ω) ODE")
       proof -
         assume sem_eq:"ODE_sem (local.adjoint I σ ν) ODE = ODE_sem (local.adjoint I σ ω) ODE"
         assume thing1:"∀i. (Inr i ∈ Inl ` ODE_vars (local.adjoint I σ ν) ODE ⟶
             snd (mk_v (local.adjoint I σ ν) ODE R solt) $ i = ODE_sem (local.adjoint I σ ω) ODE solt $ i) ∧
            (Inr i ∈ Inr ` ODE_vars (local.adjoint I σ ν) ODE ⟶
              snd (mk_v (local.adjoint I σ ν) ODE R solt) $ i = ODE_sem (local.adjoint I σ ω) ODE solt $ i)"
         assume thing2:"∀i. (Inr i ∈ Inl ` ODE_vars (local.adjoint I σ ω) ODE ⟶
              snd (mk_v (local.adjoint I σ ω) ODE R solt) $ i = ODE_sem (local.adjoint I σ ω) ODE solt $ i) ∧
             (Inr i ∈ Inr ` ODE_vars (local.adjoint I σ ω) ODE ⟶
          snd (mk_v (local.adjoint I σ ω) ODE R solt) $ i = ODE_sem (local.adjoint I σ ω) ODE solt $ i)"
         assume inr:"Inr i ∈ Inr ` ODE_vars (local.adjoint I σ ω) ODE"
         have vars_eq:"ODE_vars (local.adjoint I σ ν) ODE = ODE_vars (local.adjoint I σ ω) ODE"
          apply(induction ODE)
            unfolding adjoint_def by auto
         show "snd (mk_v (local.adjoint I σ ν) ODE R solt) $ i = snd (mk_v (local.adjoint I σ ω) ODE R solt) $ i"
           using thing1 thing2 vars_eq inr by auto
       next
         assume sem_eq:"ODE_sem (local.adjoint I σ ν) ODE = ODE_sem (local.adjoint I σ ω) ODE"
         assume thing1:"∀i. Inr i ∉ Inl ` ODE_vars (local.adjoint I σ ν) ODE ∧ Inr i ∉ Inr ` ODE_vars (local.adjoint I σ ν) ODE ⟶
             snd (mk_v (local.adjoint I σ ν) ODE R solt) $ i = snd R $ i"
         assume thing2:"∀i. Inr i ∉ Inl ` ODE_vars (local.adjoint I σ ω) ODE ∧ Inr i ∉ Inr ` ODE_vars (local.adjoint I σ ω) ODE ⟶
             snd (mk_v (local.adjoint I σ ω) ODE R solt) $ i = snd R $ i"
         assume inr:"Inr i ∉ Inr ` ODE_vars (local.adjoint I σ ω) ODE"
         have vars_eq:"ODE_vars (local.adjoint I σ ν) ODE = ODE_vars (local.adjoint I σ ω) ODE"
          apply(induction ODE)
            unfolding adjoint_def by auto
         have eq1:"snd (mk_v (local.adjoint I σ ν) ODE R solt) $ i = snd R $ i"
           using thing1 sem_eq vars_eq inr by auto
         have eq2:"snd (mk_v (local.adjoint I σ ω) ODE R solt) $ i = snd R $ i"
           using thing2 sem_eq vars_eq inr by auto
         show "snd (mk_v (local.adjoint I σ ν) ODE R solt) $ i = snd (mk_v (local.adjoint I σ ω) ODE R solt) $ i"
           using eq1 eq2 by auto
       qed
      done
    done
  done

lemma adjointFO_ode_vars:
  shows "ODE_vars (adjointFO I σ ν) ODE = ODE_vars (adjointFO I σ ω) ODE"
  apply(induction ODE)
    unfolding adjointFO_def by auto

lemma uadmit_mkv_ntadjoint:
  assumes ssafe:"⋀i. dsafe (σ i)"
  assumes good_interp:"is_interp I"
  assumes VA:"Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGO ODE}. FVT (σ y))"
  assumes osafe:"osafe ODE"
  shows "mk_v (adjointFO I σ ν) ODE = mk_v (adjointFO I σ ω) ODE"
  apply(rule ext)
  subgoal for R
    apply(rule ext)
    subgoal for solt
      apply(rule agree_UNIV_eq)
      using mk_v_agree[of "(adjointFO I σ ν)" ODE "R" solt]
      using mk_v_agree[of "(adjointFO I σ ω)" ODE "R" solt]
      using uadmit_ode_ntadjoint'[OF ssafe good_interp VA osafe]
      unfolding Vagree_def
      apply auto
      using adjointFO_ode_vars by metis+
    done
  done
    
lemma uadmit_prog_fml_adjoint':
  fixes σ I
  assumes ssafe:"ssafe σ"
  assumes good_interp:"is_interp I"
  shows "⋀ν ω. Vagree ν ω (⋃x∈SDom σ ∩ SIGP α. SFV σ x) ⟹ hpsafe α ⟹ prog_sem (adjoint I σ ν) α = prog_sem (adjoint I σ ω) α"
  and "⋀ν ω. Vagree ν ω (⋃x∈SDom σ ∩ SIGF φ. SFV σ x) ⟹ fsafe φ ⟹ fml_sem (adjoint I σ ν) φ = fml_sem (adjoint I σ ω) φ"
proof (induct "α" and "φ")
  case (Pvar x)
  then show ?case unfolding adjoint_def by auto
next
  case (Assign x e)
  assume VA:"Vagree ν ω (⋃a∈SDom σ ∩ SIGP (x := e). SFV σ a)"
  assume safe:"hpsafe (x := e)"
  from safe have dsafe:"dsafe e" by (auto dest: hpsafe.cases)
  have sub:"(⋃i∈SIGT e. case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {}) ⊆ (⋃a∈SDom σ ∩ SIGP (x := e). SFV σ a)"
    using adj_sub_assign[of σ e x] by auto
  have "dterm_sem (local.adjoint I σ ν) e = dterm_sem (local.adjoint I σ ω) e"
    by (rule uadmit_dterm_adjointS[OF ssafe good_interp agree_sub[OF sub VA] dsafe])
  then show ?case by (auto simp add: vec_eq_iff)
next
  case (DiffAssign x e)
  assume VA:"Vagree ν ω (⋃a∈SDom σ ∩ SIGP (DiffAssign x e). SFV σ a)"
  assume safe:"hpsafe (DiffAssign x e)"
  from safe have dsafe:"dsafe e" by (auto dest: hpsafe.cases)
  have sub:"(⋃i∈SIGT e. case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {}) ⊆ (⋃a∈SDom σ ∩ SIGP (DiffAssign x e). SFV σ a)"
    using adj_sub_diff_assign[of σ e] by auto
  have "dterm_sem (local.adjoint I σ ν) e = dterm_sem (local.adjoint I σ ω) e"
    by (rule uadmit_dterm_adjointS[OF ssafe good_interp agree_sub[OF sub VA] dsafe])
  then show ?case by (auto simp add: vec_eq_iff)
next
  case (Test x)
  assume IH:"⋀ν ω. Vagree ν ω (⋃a∈SDom σ ∩ SIGF x. SFV σ a) ⟹ fsafe x ⟹ fml_sem (adjoint I σ ν) x = fml_sem (adjoint I σ ω) x"
  assume VA:"Vagree ν ω (⋃a∈SDom σ ∩ SIGP (? x). SFV σ a)"
  assume hpsafe:"hpsafe (? x)"
  then have fsafe:"fsafe x" by (auto dest: hpsafe.cases)
  have sub:"(⋃a∈SDom σ ∩ SIGF x. SFV σ a) ⊆ (⋃a∈SDom σ ∩ SIGP (? x). SFV σ a)"
    by auto
  have "fml_sem (adjoint I σ ν) x = fml_sem (adjoint I σ ω) x"
    using IH[OF agree_sub[OF sub VA] fsafe] by auto
  then show ?case by auto
next
  case (EvolveODE x1 x2)
  assume IH:"⋀ν ω. Vagree ν ω (⋃a∈SDom σ ∩ SIGF x2. SFV σ a) ⟹ fsafe x2 ⟹ fml_sem (local.adjoint I σ ν) x2 = fml_sem (local.adjoint I σ ω) x2"
  assume VA:"Vagree ν ω (⋃a∈SDom σ ∩ SIGP (EvolveODE x1 x2). SFV σ a)"
  assume safe:"hpsafe (EvolveODE x1 x2)"
  then have osafe:"osafe x1" and fsafe:"fsafe x2" by (auto dest: hpsafe.cases)
  have sub1:"(⋃a∈SDom σ ∩ SIGF x2. SFV σ a) ⊆ (⋃a∈SDom σ ∩ SIGP (EvolveODE x1 x2). SFV σ a)"
    by auto
  then have VAF:"Vagree ν ω (⋃a∈SDom σ ∩ SIGF x2. SFV σ a)"
    using agree_sub[OF sub1 VA] by auto 
  note IH' = IH[OF VAF fsafe]
  have sub:"(⋃i∈{i |i. Inl i ∈ SIGO x1}. case SFunctions σ i of None ⇒ {} | Some x ⇒ FVT x) ⊆ (⋃a∈SDom σ ∩ SIGP (EvolveODE x1 x2). SFV σ a)"
    using adj_sub_ode[of σ x1 x2] by auto
  moreover have IH2:"ODE_sem (local.adjoint I σ ν) x1 = ODE_sem (local.adjoint I σ ω) x1"
    apply (rule uadmit_ode_adjoint')
       subgoal by (rule ssafe)
      subgoal by (rule good_interp)
     subgoal using agree_sub[OF sub VA] by auto
    subgoal by (rule osafe)
    done
  have mkv:"mk_v (adjoint I σ ν) x1 = mk_v (adjoint I σ ω) x1"
    apply (rule uadmit_mkv_adjoint)
       using ssafe good_interp osafe agree_sub[OF sub VA] by auto
  show ?case 
    apply auto
     subgoal for aa ba bb sol t
       apply(rule exI[where x = sol])
       apply(rule conjI)
        subgoal by auto
       apply(rule exI[where x=t])
       apply(rule conjI)
        subgoal using mkv by auto
       apply(rule conjI)
        subgoal by auto using IH2 mkv IH' by auto
    subgoal for aa ba bb sol t
      apply(rule exI[where x = sol])
      apply(rule conjI)
       subgoal by auto
      apply(rule exI[where x=t])
      apply(rule conjI)
       subgoal using mkv by auto
      apply(rule conjI)
       subgoal by auto using IH2 mkv IH' by auto
    done
next
  case (Choice x1 x2)
  assume IH1:"⋀ν ω. Vagree ν ω (⋃a∈SDom σ ∩ SIGP x1. SFV σ a) ⟹ hpsafe x1 ⟹ prog_sem (local.adjoint I σ ν) x1 = prog_sem (local.adjoint I σ ω) x1"
  assume IH2:"⋀ν ω. Vagree ν ω (⋃a∈SDom σ ∩ SIGP x2. SFV σ a) ⟹ hpsafe x2 ⟹ prog_sem (local.adjoint I σ ν) x2 = prog_sem (local.adjoint I σ ω) x2"
  assume VA:"Vagree ν ω (⋃a∈SDom σ ∩ SIGP (x1 ∪∪ x2). SFV σ a)"
  assume safe:"hpsafe (x1 ∪∪ x2)"
  from safe have
    safe1:"hpsafe x1"
    and safe2:"hpsafe x2"
    by (auto dest: hpsafe.cases)
  have sub1:"(⋃a∈SDom σ ∩ SIGP x1. SFV σ a) ⊆ (⋃a∈SDom σ ∩ SIGP (x1 ∪∪ x2). SFV σ a)"
    by auto
  have sub2:"(⋃a∈SDom σ ∩ SIGP x2. SFV σ a) ⊆ (⋃a∈SDom σ ∩ SIGP (x1 ∪∪ x2). SFV σ a)"
    by auto
  then show ?case using IH1[OF agree_sub[OF sub1 VA] safe1] IH2[OF agree_sub[OF sub2 VA] safe2] by auto
next
  case (Sequence x1 x2)
  assume IH1:"⋀ν ω. Vagree ν ω (⋃a∈SDom σ ∩ SIGP x1. SFV σ a) ⟹ hpsafe x1 ⟹ prog_sem (local.adjoint I σ ν) x1 = prog_sem (local.adjoint I σ ω) x1"
  assume IH2:"⋀ν ω. Vagree ν ω (⋃a∈SDom σ ∩ SIGP x2. SFV σ a) ⟹ hpsafe x2 ⟹ prog_sem (local.adjoint I σ ν) x2 = prog_sem (local.adjoint I σ ω) x2"
  assume VA:"Vagree ν ω (⋃a∈SDom σ ∩ SIGP (x1 ;; x2). SFV σ a)"
  assume safe:"hpsafe (x1 ;; x2)"
  from safe have
    safe1:"hpsafe x1"
    and safe2:"hpsafe x2"
    by (auto dest: hpsafe.cases)
  have sub1:"(⋃a∈SDom σ ∩ SIGP x1. SFV σ a) ⊆ (⋃a∈SDom σ ∩ SIGP (x1 ;; x2). SFV σ a)"
    by auto
  have sub2:"(⋃a∈SDom σ ∩ SIGP x2. SFV σ a) ⊆ (⋃a∈SDom σ ∩ SIGP (x1 ;; x2). SFV σ a)"
    by auto
  then show ?case using IH1[OF agree_sub[OF sub1 VA] safe1] IH2[OF agree_sub[OF sub2 VA] safe2] by auto
next
  case (Loop x)
  assume IH:"⋀ν ω. Vagree ν ω (⋃a∈SDom σ ∩ SIGP x. SFV σ a) ⟹ hpsafe x ⟹ prog_sem (local.adjoint I σ ν) x = prog_sem (local.adjoint I σ ω) x"
  assume VA:"Vagree ν ω (⋃a∈SDom σ ∩ SIGP (x**). SFV σ a)"
  assume safe:"hpsafe (x**)"
  from safe have
    safe:"hpsafe x"
    by (auto dest: hpsafe.cases)
  have sub:"(⋃a∈SDom σ ∩ SIGP x. SFV σ a) ⊆ (⋃a∈SDom σ ∩ SIGP (x**). SFV σ a)"
    by auto
  show ?case using IH[OF agree_sub[OF sub VA] safe] by auto
next
  case (Geq x1 x2)
  assume VA:"Vagree ν ω (⋃a∈SDom σ ∩ SIGF (Geq x1 x2). SFV σ a)"
  assume safe:"fsafe (Geq x1 x2)"
  then have dsafe1:"dsafe x1" and dsafe2:"dsafe x2" by (auto dest: fsafe.cases)
  have sub1:"(⋃i∈SIGT x1. case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {}) ⊆ (⋃a∈SDom σ ∩ SIGF (Geq x1 x2). SFV σ a)"
    using adj_sub_geq1[of σ x1 x2] by auto
  have sub2:"(⋃i∈SIGT x2. case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {}) ⊆ (⋃a∈SDom σ ∩ SIGF (Geq x1 x2). SFV σ a)"
    using adj_sub_geq2[of σ x2 x1] by auto
  have "dterm_sem (local.adjoint I σ ν) x1 = dterm_sem (local.adjoint I σ ω) x1"
    by (rule uadmit_dterm_adjointS[OF ssafe good_interp agree_sub[OF sub1 VA] dsafe1])
  moreover have "dterm_sem (local.adjoint I σ ν) x2 = dterm_sem (local.adjoint I σ ω) x2"
    by (rule uadmit_dterm_adjointS[OF ssafe good_interp agree_sub[OF sub2 VA] dsafe2])
  ultimately show ?case by auto
next
  case (Prop x1 x2 ν ω)
  assume VA:"Vagree ν ω (⋃a∈SDom σ ∩ SIGF ($φ x1 x2). SFV σ a)"
  assume safe:"fsafe ($φ x1 x2)"
  then have safes:"⋀i. dsafe (x2 i)" using dfree_is_dsafe by auto
  have subs:"⋀j. (⋃i∈SIGT (x2 j). case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {}) ⊆ (⋃a∈SDom σ ∩ SIGF ($φ x1 x2). SFV σ a)"
    subgoal for j using adj_sub_prop[of σ x2 j x1] by auto
    done
  have "⋀i. dterm_sem (local.adjoint I σ ν) (x2 i) = dterm_sem (local.adjoint I σ ω) (x2 i)"
    by (rule uadmit_dterm_adjointS[OF ssafe good_interp agree_sub[OF subs VA] safes])
  then have vec_eq:"⋀R. (χ i. dterm_sem (local.adjoint I σ ν) (x2 i) R) = (χ i. dterm_sem (local.adjoint I σ ω) (x2 i) R)"
    by (auto simp add: vec_eq_iff)
  from VA have VAs:"⋀j. Vagree ν ω (⋃i∈SIGT (x2 j). case SFunctions σ i of Some a ⇒ FVT a | None ⇒ {})"
    unfolding Vagree_def SIGT.simps using rangeI 
    by (metis (no_types, lifting) subsetD subs)
  have SIGF:"⋀a. SPredicates σ x1 = Some a ⟹ Inr (Inr x1) ∈ SDom σ ∩ SIGF ($φ x1 x2)" unfolding SDom_def
    by auto
  have VAsub:"⋀a. SPredicates σ x1 = Some a ⟹ (FVF a) ⊆ (⋃i∈SDom σ ∩ SIGF ($φ x1 x2). SFV σ i)"
    using SIGF by auto
  have VAf:"⋀a. SPredicates σ x1 = Some a ⟹ Vagree ν ω (FVF a)"
    using agree_sub[OF VAsub VA] by auto
  then show ?case 
    apply(cases "SPredicates σ x1")
    defer
    subgoal for a
    proof -
      assume some:"SPredicates σ x1 = Some a"
      note FVF = VAf[OF some]
      have dsafe:"⋀f f'. SFunctions σ f = Some f' ⟹ dsafe f'"
        using ssafe dfree_is_dsafe unfolding ssafe_def by auto
      have dsem:"⋀R . (ν ∈ fml_sem (extendf I R) a) = (ω ∈ fml_sem (extendf I R) a)"
        subgoal for R
          apply (rule coincidence_formula)
            subgoal using ssafe unfolding ssafe_def using some by auto
           subgoal unfolding Iagree_def by auto
          subgoal by (rule FVF)
        done
      done
      have pred_eq:"⋀R. Predicates (local.adjoint I σ ν) x1 R = Predicates (local.adjoint I σ ω) x1 R"
        using dsem some unfolding adjoint_def by auto
      show "fml_sem (local.adjoint I σ ν) ($φ x1 x2) = fml_sem (local.adjoint I σ ω) ($φ x1 x2)"
        apply auto
         subgoal for a b using pred_eq[of "(χ i. dterm_sem (local.adjoint I σ ν) (x2 i) (a, b))"] vec_eq by auto
        subgoal for a b using pred_eq[of "(χ i. dterm_sem (local.adjoint I σ ν) (x2 i) (a, b))"] vec_eq by auto
        done
    qed
    unfolding adjoint_def using local.adjoint_def local.vec_eq apply auto
    done
next
  case (Not x)
  assume IH:"⋀ν ω. Vagree ν ω (⋃a∈SDom σ ∩ SIGF x. SFV σ a) ⟹ fsafe x ⟹ fml_sem (local.adjoint I σ ν) x = fml_sem (local.adjoint I σ ω) x"
  assume VA:"Vagree ν ω (⋃a∈SDom σ ∩ SIGF (Not x). SFV σ a)"
  assume safe:"fsafe (Not x)"
  from safe have
    safe:"fsafe x"
    by (auto dest: fsafe.cases)
  have sub:"(⋃a∈SDom σ ∩ SIGF x. SFV σ a) ⊆ (⋃a∈SDom σ ∩ SIGF (Not x). SFV σ a)"
    by auto
  show ?case using IH[OF agree_sub[OF sub VA] safe] by auto
next
  case (And x1 x2)
  assume IH1:"⋀ν ω. Vagree ν ω (⋃a∈SDom σ ∩ SIGF x1. SFV σ a) ⟹ fsafe x1 ⟹ fml_sem (local.adjoint I σ ν) x1 = fml_sem (local.adjoint I σ ω) x1"
  assume IH2:"⋀ν ω. Vagree ν ω (⋃a∈SDom σ ∩ SIGF x2. SFV σ a) ⟹ fsafe x2 ⟹ fml_sem (local.adjoint I σ ν) x2 = fml_sem (local.adjoint I σ ω) x2"
  assume VA:"Vagree ν ω (⋃a∈SDom σ ∩ SIGF (And x1 x2). SFV σ a)"
  assume safe:"fsafe (And x1 x2)"
  from safe have
    safe1:"fsafe x1"
    and safe2:"fsafe x2"
    by (auto dest: fsafe.cases)
  have sub1:"(⋃a∈SDom σ ∩ SIGF x1. SFV σ a) ⊆ (⋃a∈SDom σ ∩ SIGF (And x1 x2). SFV σ a)"
    by auto
  have sub2:"(⋃a∈SDom σ ∩ SIGF x2. SFV σ a) ⊆ (⋃a∈SDom σ ∩ SIGF (And x1 x2). SFV σ a)"
    by auto
  show ?case using IH1[OF agree_sub[OF sub1 VA] safe1] IH2[OF agree_sub[OF sub2 VA] safe2] by auto
next
  case (Exists x1 x2)
  assume IH1:"⋀ν ω. Vagree ν ω (⋃a∈SDom σ ∩ SIGF x2. SFV σ a) ⟹ fsafe x2 ⟹ fml_sem (local.adjoint I σ ν) x2 = fml_sem (local.adjoint I σ ω) x2"
  assume VA:"Vagree ν ω (⋃a∈SDom σ ∩ SIGF (Exists x1 x2). SFV σ a)"
  assume safe:"fsafe (Exists x1 x2)"
  from safe have safe1:"fsafe x2"
    by (auto dest: fsafe.cases)
  have sub1:"(⋃a∈SDom σ ∩ SIGF x2. SFV σ a) ⊆ (⋃a∈SDom σ ∩ SIGF (Exists x1 x2). SFV σ a)"
    by auto
  show ?case using IH1[OF agree_sub[OF sub1 VA] safe1] by auto
next
  case (Diamond x1 x2)
  assume IH1:"⋀ν ω. Vagree ν ω (⋃a∈SDom σ ∩ SIGP x1. SFV σ a) ⟹ hpsafe x1 ⟹ prog_sem (local.adjoint I σ ν) x1 = prog_sem (local.adjoint I σ ω) x1"
  assume IH2:"⋀ν ω. Vagree ν ω (⋃a∈SDom σ ∩ SIGF x2. SFV σ a) ⟹ fsafe x2 ⟹ fml_sem (local.adjoint I σ ν) x2 = fml_sem (local.adjoint I σ ω) x2"
  assume VA:"Vagree ν ω (⋃a∈SDom σ ∩ SIGF (Diamond x1 x2). SFV σ a)"
  assume safe:"fsafe (Diamond x1 x2)"
  from safe have
    safe1:"hpsafe x1"
    and safe2:"fsafe x2"
    by (auto dest: fsafe.cases)
  have sub1:"(⋃a∈SDom σ ∩ SIGP x1. SFV σ a) ⊆ (⋃a∈SDom σ ∩ SIGF (Diamond x1 x2). SFV σ a)"
    by auto
  have sub2:"(⋃a∈SDom σ ∩ SIGF x2. SFV σ a) ⊆ (⋃a∈SDom σ ∩ SIGF (Diamond x1 x2). SFV σ a)"
    by auto
  show ?case using IH1[OF agree_sub[OF sub1 VA] safe1] IH2[OF agree_sub[OF sub2 VA] safe2] by auto
next
  case (InContext x1 x2)
  assume IH1:"⋀ν ω. Vagree ν ω (⋃a∈SDom σ ∩ SIGF x2. SFV σ a) ⟹ fsafe x2 ⟹ fml_sem (local.adjoint I σ ν) x2 = fml_sem (local.adjoint I σ ω) x2"
  assume VA:"Vagree ν ω (⋃a∈SDom σ ∩ SIGF (InContext x1 x2). SFV σ a)"
  assume safe:"fsafe (InContext x1 x2)"
  from safe have  safe1:"fsafe x2"
    by (auto dest: fsafe.cases)
  have sub:"(⋃a∈SDom σ ∩ SIGF x2. SFV σ a) ⊆ (⋃a∈SDom σ ∩ SIGF (InContext x1 x2). SFV σ a)"
    by auto
  show ?case using IH1[OF agree_sub[OF sub VA] safe1]  
    unfolding adjoint_def by auto
qed
 
lemma uadmit_prog_adjoint:
  assumes PUA:"PUadmit σ a U"
  assumes VA:"Vagree ν ω (-U)"
  assumes hpsafe:"hpsafe a"
  assumes ssafe:"ssafe σ"
  assumes good_interp:"is_interp I"
  shows "prog_sem (adjoint I σ ν) a = prog_sem (adjoint I σ ω) a"
proof -
  have sub:"(⋃x∈SDom σ ∩ SIGP a. SFV σ x) ⊆ -U" using PUA unfolding PUadmit_def by auto
  have VA':"Vagree ν ω (⋃x∈SDom σ ∩ SIGP a. SFV σ x)" using agree_sub[OF sub VA] by auto
  show ?thesis 
    apply(rule uadmit_prog_fml_adjoint'[OF ssafe good_interp])
     subgoal by (rule VA')
    subgoal by (rule hpsafe)
    done
qed

lemma uadmit_fml_adjoint:
  assumes FUA:"FUadmit σ φ U"
  assumes VA:"Vagree ν ω (-U)"
  assumes fsafe:"fsafe φ"
  assumes ssafe:"ssafe σ"
  assumes good_interp:"is_interp I"
  shows "fml_sem (adjoint I σ ν) φ = fml_sem (adjoint I σ ω) φ"
proof -
  have sub:"(⋃x∈SDom σ ∩ SIGF φ. SFV σ x) ⊆ -U" using FUA unfolding FUadmit_def by auto
  have VA':"Vagree ν ω (⋃x∈SDom σ ∩ SIGF φ. SFV σ x)" using agree_sub[OF sub VA] by auto
  show ?thesis 
    apply(rule uadmit_prog_fml_adjoint'[OF ssafe good_interp])
     subgoal by (rule VA')
    subgoal by (rule fsafe)
    done
qed

lemma ntadj_sub_assign:"⋀e σ x. (⋃y∈{y. Inr y ∈ SIGT e}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inr y) ∈ SIGP (Assign x e)}. FVT (σ y))"
  by auto

lemma ntadj_sub_diff_assign:"⋀e σ x. (⋃y∈{y. Inl y ∈ SIGT e}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inl y) ∈ SIGP (DiffAssign x e)}. FVT (σ y))"
  by auto
   
lemma ntadj_sub_geq1:"⋀σ x1 x2. (⋃y∈{y. Inl y ∈ SIGT x1}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inl y) ∈ SIGF (Geq x1 x2)}. FVT (σ y))"
  by auto

lemma ntadj_sub_geq2:"⋀σ x1 x2. (⋃y∈{y. Inl y ∈ SIGT x2}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inl y) ∈ SIGF (Geq x1 x2)}. FVT (σ y))"
  by auto

lemma ntadj_sub_prop:"⋀σ x1 x2 j. (⋃y∈{y. Inl y ∈ SIGT (x2 j)}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inl y) ∈ SIGF ($φ x1 x2)}.FVT (σ y))"
  by auto

lemma ntadj_sub_ode:"⋀σ x1 x2. (⋃y∈{y. Inl (Inl y) ∈ SIGO x1}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inl y) ∈ SIGP (EvolveODE x1 x2)}. FVT (σ y))"
  by auto

lemma uadmit_prog_fml_ntadjoint':
  fixes σ I
  assumes ssafe:"⋀i. dsafe (σ i)"
  assumes good_interp:"is_interp I"
  shows "⋀ν ω. Vagree ν ω (⋃x∈{x. Inl (Inr x) ∈ SIGP α}. FVT (σ x)) ⟹ hpsafe α ⟹ prog_sem (adjointFO I σ ν) α = prog_sem (adjointFO I σ ω) α"
  and "⋀ν ω. Vagree ν ω (⋃x∈{x. Inl (Inr x) ∈ SIGF φ}. FVT (σ x)) ⟹ fsafe φ ⟹ fml_sem (adjointFO I σ ν) φ = fml_sem (adjointFO I σ ω) φ"
proof (induct "α" and "φ")
  case (Pvar x)
  then show ?case unfolding adjointFO_def by auto
next
  case (Assign x e)
  assume VA:"Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGP (Assign x e)}. FVT (σ y))"
  assume safe:"hpsafe (x := e)"
  from safe have dsafe:"dsafe e" by (auto dest: hpsafe.cases)
  have sub:"(⋃y∈{y. Inr y ∈ SIGT e}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inr y) ∈ SIGP (Assign x e)}. FVT (σ y))"
    using ntadj_sub_assign[of σ e x] by auto
  have VA':"(Vagree ν ω (⋃i∈{i. Inr i ∈ SIGT e}. FVT (σ i)))"
    using agree_sub[OF sub VA] by auto
  have "dterm_sem (adjointFO I σ ν) e = dterm_sem (adjointFO I σ ω) e"
    using uadmit_dterm_ntadjoint'[of σ I ν ω e] ssafe good_interp agree_sub[OF sub VA] dsafe by auto
  then show ?case by (auto simp add: vec_eq_iff)
next
  case (DiffAssign x e)
  assume VA:"Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGP (DiffAssign x e)}. FVT (σ y))"
  assume safe:"hpsafe (DiffAssign x e)"
  from safe have dsafe:"dsafe e" by (auto dest: hpsafe.cases)
  have sub:"(⋃y∈{y. Inr y ∈ SIGT e}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inr y) ∈ SIGP (DiffAssign x e)}. FVT (σ y))"
    using ntadj_sub_assign[of σ e x] by auto
  have VA':"(Vagree ν ω (⋃i∈{i. Inr i ∈ SIGT e}. FVT (σ i)))"
    using agree_sub[OF sub VA] by auto
  have "dterm_sem (adjointFO I σ ν) e = dterm_sem (adjointFO I σ ω) e"
    using uadmit_dterm_ntadjoint'[of σ I ν ω e] ssafe good_interp agree_sub[OF sub VA] dsafe by auto
  then show ?case by (auto simp add: vec_eq_iff)
next
  case (Test x)
  assume IH:"⋀ν ω. Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGF x}. FVT (σ y)) ⟹ fsafe x ⟹ fml_sem (adjointFO I σ ν) x = fml_sem (adjointFO I σ ω) x"
  assume VA:"Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGP (? x)}. FVT (σ y))"
  assume hpsafe:"hpsafe (? x)"
  then have fsafe:"fsafe x" by (auto dest: hpsafe.cases)
  have sub:"(⋃y∈{y. Inl (Inr y) ∈ SIGF x}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inr y) ∈ SIGP (? x)}. FVT (σ y))"
    by auto
  have "fml_sem (adjointFO I σ ν) x = fml_sem (adjointFO I σ ω) x"
    using IH[OF agree_sub[OF sub VA] fsafe] by auto
  then show ?case by auto
next
  case (EvolveODE x1 x2)
  assume IH:"⋀ν ω. Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGF x2}. FVT (σ y)) ⟹ fsafe x2 ⟹ fml_sem (adjointFO I σ ν) x2 = fml_sem (adjointFO I σ ω) x2"
  assume VA:"Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGP (EvolveODE x1 x2)}. FVT (σ y))"
  assume safe:"hpsafe (EvolveODE x1 x2)"
  then have osafe:"osafe x1" and fsafe:"fsafe x2" by (auto dest: hpsafe.cases)
  have sub1:"(⋃y∈{y. Inl (Inr y) ∈ SIGF x2}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inr y) ∈ SIGP (EvolveODE x1 x2)}. FVT (σ y))"
    by auto
  then have VAF:"Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGF x2}. FVT (σ y))"
    using agree_sub[OF sub1 VA] by auto 
  note IH' = IH[OF VAF fsafe]
  have sub:"(⋃y∈{y. Inl (Inr y) ∈ SIGO x1}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inr y) ∈ SIGP (EvolveODE x1 x2)}. FVT (σ y))"
    by auto
  moreover have IH2:"ODE_sem (adjointFO I σ ν) x1 = ODE_sem (adjointFO I σ ω) x1"
    apply (rule uadmit_ode_ntadjoint')
       subgoal by (rule ssafe)
      subgoal by (rule good_interp)
     defer subgoal by (rule osafe)
    using agree_sub[OF sub VA] by auto
  have mkv:"mk_v (adjointFO I σ ν) x1 = mk_v (adjointFO I σ ω) x1"
    apply (rule uadmit_mkv_ntadjoint)
       using ssafe good_interp osafe agree_sub[OF sub VA] by auto
  show ?case 
    apply auto
    subgoal for aa ba bb sol t
      apply(rule exI[where x = sol])
      apply(rule conjI)
       subgoal by auto
      apply(rule exI[where x=t])
      apply(rule conjI)
       subgoal using mkv by auto
      apply(rule conjI)
       subgoal by auto using IH2 mkv IH' by auto
    subgoal for aa ba bb sol t
      apply(rule exI[where x = sol])
      apply(rule conjI)
       subgoal by auto
      apply(rule exI[where x=t])
      apply(rule conjI)
       subgoal using mkv by auto
      apply(rule conjI)
       subgoal by auto using IH2 mkv IH' by auto
    done
next
  case (Choice x1 x2)
  assume IH1:"⋀ν ω. Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGP x1}. FVT (σ y)) ⟹ hpsafe x1 ⟹ prog_sem (adjointFO I σ ν) x1 = prog_sem (adjointFO I σ ω) x1"
  assume IH2:"⋀ν ω. Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGP x2}. FVT (σ y)) ⟹ hpsafe x2 ⟹ prog_sem (adjointFO I σ ν) x2 = prog_sem (adjointFO I σ ω) x2"
  assume VA:"Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGP (x1 ∪∪ x2)}. FVT (σ y))"
  assume safe:"hpsafe (x1 ∪∪ x2)"
  from safe have
    safe1:"hpsafe x1"
    and safe2:"hpsafe x2"
    by (auto dest: hpsafe.cases)
  have sub1:"(⋃y∈{y. Inl (Inr y) ∈ SIGP (x1)}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inr y) ∈ SIGP (x1 ∪∪ x2)}. FVT (σ y))"
    by auto
  have sub2:"(⋃y∈{y. Inl (Inr y) ∈ SIGP (x2)}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inr y) ∈ SIGP (x1 ∪∪ x2)}. FVT (σ y))"
    by auto
  then show ?case using IH1[OF agree_sub[OF sub1 VA] safe1] IH2[OF agree_sub[OF sub2 VA] safe2] by auto
next
  case (Sequence x1 x2)
  assume IH1:"⋀ν ω. Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGP x1}. FVT (σ y)) ⟹ hpsafe x1 ⟹ prog_sem (adjointFO I σ ν) x1 = prog_sem (adjointFO I σ ω) x1"
  assume IH2:"⋀ν ω. Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGP x2}. FVT (σ y)) ⟹ hpsafe x2 ⟹ prog_sem (adjointFO I σ ν) x2 = prog_sem (adjointFO I σ ω) x2"
  assume VA:"Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGP (x1 ;; x2)}. FVT (σ y))"
  assume safe:"hpsafe (x1 ;; x2)"
  from safe have
    safe1:"hpsafe x1"
    and safe2:"hpsafe x2"
    by (auto dest: hpsafe.cases)
  have sub1:"(⋃y∈{y. Inl (Inr y) ∈ SIGP x1}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inr y) ∈ SIGP (x1 ;; x2)}. FVT (σ y))"
    by auto
  have sub2:"(⋃y∈{y. Inl (Inr y) ∈ SIGP x2}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inr y) ∈ SIGP (x1 ;; x2)}. FVT (σ y))"
    by auto
  then show ?case using IH1[OF agree_sub[OF sub1 VA] safe1] IH2[OF agree_sub[OF sub2 VA] safe2] by auto
next
  case (Loop x)
  assume IH:"⋀ν ω. Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGP x}. FVT (σ y)) ⟹ hpsafe x ⟹ prog_sem (adjointFO I σ ν) x = prog_sem (adjointFO I σ ω) x"
  assume VA:"Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGP (x** )}. FVT (σ y))"
  assume safe:"hpsafe (x** )"
  from safe have
    safe:"hpsafe x"
    by (auto dest: hpsafe.cases)
  have sub:"(⋃y∈{y. Inl (Inr y) ∈ SIGP (x )}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inr y) ∈ SIGP (x** )}. FVT (σ y))"
    by auto
  show ?case using IH[OF agree_sub[OF sub VA] safe] by auto
next
  case (Geq x1 x2)
  assume VA:"Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGF (Geq x1 x2)}. FVT (σ y))"
  assume safe:"fsafe (Geq x1 x2)"
  then have dsafe1:"dsafe x1" and dsafe2:"dsafe x2" by (auto dest: fsafe.cases)
  have sub1:"(⋃y∈{y. Inr y ∈ SIGT x1}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inr y) ∈ SIGF (Geq x1 x2)}. FVT (σ y))"
    by auto
  have sub2:"(⋃y∈{y. Inr y ∈ SIGT x2}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inr y) ∈ SIGF (Geq x1 x2)}. FVT (σ y))"
    by auto
  have "dterm_sem (adjointFO I σ ν) x1 = dterm_sem (adjointFO I σ ω) x1"
    by (rule uadmit_dterm_ntadjoint'[OF ssafe good_interp agree_sub[OF sub1 VA] dsafe1])
  moreover have "dterm_sem (adjointFO I σ ν) x2 = dterm_sem (adjointFO I σ ω) x2"
    by (rule uadmit_dterm_ntadjoint'[OF ssafe good_interp agree_sub[OF sub2 VA] dsafe2])
  ultimately show ?case by auto
next
  case (Prop x1 x2 ν ω)
  assume VA:"Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGF ($φ x1 x2)}. FVT (σ y))"
  assume safe:"fsafe ($φ x1 x2)"
  then have safes:"⋀i. dsafe (x2 i)" using dfree_is_dsafe by auto
  have subs:"⋀j. (⋃y∈{y. Inr y ∈ SIGT (x2 j)}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inr y) ∈ SIGF ($φ x1 x2)}. FVT (σ y))"
    subgoal for j  by auto
    done
  have "⋀i. dterm_sem (adjointFO I σ ν) (x2 i) = dterm_sem (adjointFO I σ ω) (x2 i)"
    by (rule uadmit_dterm_ntadjoint'[OF ssafe good_interp agree_sub[OF subs VA] safes])
  then have vec_eq:"⋀R. (χ i. dterm_sem (adjointFO I σ ν) (x2 i) R) = (χ i. dterm_sem (adjointFO I σ ω) (x2 i) R)"
    by (auto simp add: vec_eq_iff)
  from VA have VAs:"⋀j. Vagree ν ω (⋃y∈{y. Inr y ∈ SIGT (x2 j)}. FVT (σ y))"
    subgoal for j 
      using agree_sub[OF subs[of j] VA] by auto
    done
  then show ?case 
    using vec_eq by (auto simp add: adjointFO_def)
next
  case (Not x)
  assume IH:"⋀ν ω. Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGF x}. FVT (σ y)) ⟹ fsafe x ⟹ fml_sem (adjointFO I σ ν) x = fml_sem (adjointFO I σ ω) x"
  assume VA:"Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGF (Not x)}. FVT (σ y))"
  assume safe:"fsafe (Not x)"
  from safe have
    safe:"fsafe x"
    by (auto dest: fsafe.cases)
  have sub:"(⋃y∈{y. Inl (Inr y) ∈ SIGF x}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inr y) ∈ SIGF (Not x)}. FVT (σ y))"
    by auto
  show ?case using IH[OF agree_sub[OF sub VA] safe] by auto
next
  case (And x1 x2)
  assume IH1:"⋀ν ω. Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGF x1}. FVT (σ y)) ⟹ fsafe x1 ⟹ fml_sem (adjointFO I σ ν) x1 = fml_sem (adjointFO I σ ω) x1"
  assume IH2:"⋀ν ω. Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGF x2}. FVT (σ y)) ⟹ fsafe x2 ⟹ fml_sem (adjointFO I σ ν) x2 = fml_sem (adjointFO I σ ω) x2"
  assume VA:"Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGF (And x1 x2)}. FVT (σ y))"
  assume safe:"fsafe (And x1 x2)"
  from safe have
    safe1:"fsafe x1"
and safe2:"fsafe x2"
    by (auto dest: fsafe.cases)
  have sub1:"(⋃y∈{y. Inl (Inr y) ∈ SIGF x1}. FVT (σ y))  ⊆ (⋃y∈{y. Inl (Inr y) ∈ SIGF (And x1 x2)}. FVT (σ y))"
    by auto
  have sub2:"(⋃y∈{y. Inl (Inr y) ∈ SIGF x2}. FVT (σ y))  ⊆ (⋃y∈{y. Inl (Inr y) ∈ SIGF (And x1 x2)}. FVT (σ y))"
    by auto
  show ?case using IH1[OF agree_sub[OF sub1 VA] safe1] IH2[OF agree_sub[OF sub2 VA] safe2] by auto
next
  case (Exists x1 x2)
  assume IH1:"⋀ν ω. Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGF x2}. FVT (σ y)) ⟹ fsafe x2 ⟹ fml_sem (adjointFO I σ ν) x2 = fml_sem (adjointFO I σ ω) x2"
  assume VA:"Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGF (Exists x1 x2)}. FVT (σ y))"
  assume safe:"fsafe (Exists x1 x2)"
  from safe have safe1:"fsafe x2"
    by (auto dest: fsafe.cases)
  have sub1:"(⋃y∈{y. Inl (Inr y) ∈ SIGF x2}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inr y) ∈ SIGF (Exists x1 x2)}. FVT (σ y))"
    by auto
  show ?case using IH1[OF agree_sub[OF sub1 VA] safe1] by auto
next
  case (Diamond x1 x2)
  assume IH1:"⋀ν ω. Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGP x1}. FVT (σ y)) ⟹ hpsafe x1 ⟹ prog_sem (adjointFO I σ ν) x1 = prog_sem (adjointFO I σ ω) x1"
  assume IH2:"⋀ν ω. Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGF x2}. FVT (σ y)) ⟹ fsafe x2 ⟹ fml_sem (adjointFO I σ ν) x2 = fml_sem (adjointFO I σ ω) x2"
  assume VA:"Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGF (Diamond x1 x2)}. FVT (σ y))"
  assume safe:"fsafe (Diamond x1 x2)"
  from safe have
    safe1:"hpsafe x1"
and safe2:"fsafe x2"
    by (auto dest: fsafe.cases)
  have sub1:"(⋃y∈{y. Inl (Inr y) ∈ SIGP x1}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inr y) ∈ SIGF (Diamond x1 x2)}. FVT (σ y))"
    by auto
  have sub2:"(⋃y∈{y. Inl (Inr y) ∈ SIGF x2}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inr y) ∈ SIGF (Diamond x1 x2)}. FVT (σ y))"
    by auto
  show ?case using IH1[OF agree_sub[OF sub1 VA] safe1] IH2[OF agree_sub[OF sub2 VA] safe2] by auto
next
  case (InContext x1 x2)
  assume IH1:"⋀ν ω. Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGF x2}. FVT (σ y)) ⟹ fsafe x2 ⟹ fml_sem (adjointFO I σ ν) x2 = fml_sem (adjointFO I σ ω) x2"
  assume VA:"Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGF (InContext x1 x2)}. FVT (σ y))"
  assume safe:"fsafe (InContext x1 x2)"
  from safe have  safe1:"fsafe x2"
    by (auto dest: fsafe.cases)
  have sub:"(⋃y∈{y. Inl (Inr y) ∈ SIGF x2}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inr y) ∈ SIGF (InContext x1 x2)}. FVT (σ y))"
    by auto
  show ?case using IH1[OF agree_sub[OF sub VA] safe1]  
    unfolding adjointFO_def by auto
qed

lemma uadmit_prog_ntadjoint:
  assumes TUA:"PUadmitFO σ α U"
  assumes VA:"Vagree ν ω (-U)"
  assumes dfree:"⋀i . dsafe (σ i)"
  assumes hpsafe:"hpsafe α"
  assumes good_interp:"is_interp I"
  shows  "prog_sem (adjointFO I σ ν) α = prog_sem (adjointFO I σ ω) α"
proof -
  have sub:"(⋃x∈{x. Inl (Inr x) ∈ SIGP α}. FVT (σ x)) ⊆ -U" using TUA unfolding PUadmitFO_def by auto
  have VA':"Vagree ν ω (⋃x∈{x. Inl (Inr x) ∈ SIGP α}. FVT (σ x))" using agree_sub[OF sub VA] by auto
  show ?thesis 
    apply(rule uadmit_prog_fml_ntadjoint'[OF dfree good_interp])
     subgoal by (rule VA')
    subgoal by (rule hpsafe)
    done
qed

lemma uadmit_fml_ntadjoint:
  assumes TUA:"FUadmitFO σ φ U"
  assumes VA:"Vagree ν ω (-U)"
  assumes dfree:"⋀i . dsafe (σ i)"
  assumes fsafe:"fsafe φ"
  assumes good_interp:"is_interp I"
  shows  "fml_sem (adjointFO I σ ν) φ = fml_sem (adjointFO I σ ω) φ"
proof -
  have sub:"(⋃x∈{x. Inl (Inr x) ∈ SIGF φ}. FVT (σ x)) ⊆ -U" using TUA unfolding FUadmitFO_def by auto
  have VA':"Vagree ν ω (⋃x∈{x. Inl (Inr x) ∈ SIGF φ}. FVT (σ x))" using agree_sub[OF sub VA] by auto
  show ?thesis 
    apply(rule uadmit_prog_fml_ntadjoint'[OF dfree good_interp])
     subgoal by (rule VA')
    subgoal by (rule fsafe)
    done
qed

subsection‹Substitution theorems for terms›
lemma nsubst_sterm:
  fixes I::"('sf, 'sc, 'sz) interp"
  fixes ν::"'sz state"
  shows "TadmitFFO σ θ  ⟹ (⋀i. dsafe (σ i)) ⟹ sterm_sem I (TsubstFO θ σ) (fst ν) = sterm_sem (adjointFO I σ ν) θ (fst ν)"
proof (induction rule: TadmitFFO.induct)
  case (TadmitFFO_Fun1 σ args f)
  then show ?case by(auto simp add:  adjointFO_def)
next
  case (TadmitFFO_Fun2 σ args f)
  then show ?case
    apply(auto simp add: adjointFO_def) 
    by (simp add: dsem_to_ssem)
qed (auto)

lemma nsubst_sterm':
  fixes I::"('sf, 'sc, 'sz) interp"
  fixes a b::"'sz simple_state"
  shows "TadmitFFO σ θ ⟹ (⋀i. dsafe (σ i)) ⟹ sterm_sem I (TsubstFO θ σ) a = sterm_sem (adjointFO I σ (a,b)) θ a"
  using nsubst_sterm by (metis fst_conv)

lemma ntsubst_preserves_free:
"dfree θ ⟹ (⋀i. dfree (σ i)) ⟹ dfree(TsubstFO θ σ)"
proof (induction rule: dfree.induct) 
  case (dfree_Fun args i) then show "?case"
    by (cases "i") (auto intro:dfree.intros)
qed (auto intro: dfree.intros)

lemma tsubst_preserves_free:
"dfree θ ⟹  (⋀i f'. SFunctions σ i = Some f' ⟹ dfree f') ⟹ dfree(Tsubst θ σ)"
proof (induction rule: dfree.induct) 
  case (dfree_Fun args i) then show "?case" 
    by (cases "SFunctions σ i") (auto intro:dfree.intros ntsubst_preserves_free)
qed (auto intro: dfree.intros)

lemma subst_sterm:
  fixes I::"('sf, 'sc, 'sz) interp"
  fixes ν::"'sz state"
  shows "
    TadmitF σ θ  ⟹
    (⋀i f'. SFunctions σ i = Some f' ⟹ dfree f') ⟹ 
     sterm_sem I (Tsubst θ σ) (fst ν) = sterm_sem (adjoint I σ ν) θ (fst ν)"
proof (induction rule: TadmitF.induct)
  case (TadmitF_Fun1  σ args f f') then
    have subFree:" TadmitFFO (λi. Tsubst (args i) σ) f'" 
      and frees:"⋀i. dfree (Tsubst (args i) σ)" 
      and TFA:"⋀i. TadmitF σ (args i)"
      and NTFA:"TadmitFFO (λi. Tsubst (args i) σ) f'"
      and theIH:"⋀i. sterm_sem I (Tsubst (args i) σ) (fst ν) = sterm_sem (local.adjoint I σ ν) (args i) (fst ν)"
        by auto
      from frees have safes:"⋀i. dsafe (Tsubst (args i) σ)"
        by (simp add: dfree_is_dsafe) 
  assume subFreeer:"(⋀i f'. SFunctions σ i = Some f' ⟹ dfree f')"
  note admit = TadmitF_Fun1.hyps(1) and sfree = TadmitF_Fun1.prems(1)
  have IH:"(⋀i. sterm_sem I (Tsubst (args i) σ) (fst ν) = sterm_sem (adjoint I σ ν) (args i) (fst ν))" 
    using  admit TadmitF_Fun1.prems TadmitF_Fun1.IH by auto
  have vec_eq:"(χ i. sterm_sem (local.adjoint I σ ν) (args i) (fst ν)) = (χ i. sterm_sem I (Tsubst (args i) σ) (fst ν))"
    apply(rule vec_extensionality)
    using IH by auto
  assume some:"SFunctions σ f = Some f'" 
  let ?sub = "(λ i. Tsubst (args i) σ)"
  have IH2:"sterm_sem I (TsubstFO f' ?sub) (fst ν) = sterm_sem (adjointFO I ?sub ν) f' (fst ν)"
    apply(rule nsubst_sterm)
     apply(rule subFree)
    by (rule safes)
  show "?case"
    apply (simp add: some)
    unfolding vec_eq IH2
    by (auto simp add: some adjoint_free[OF subFreeer, of σ "(λ x y. x)" I ν] adjointFO_free[OF frees])      
next
  case (TadmitF_Fun2  σ args f) 
  assume none:"SFunctions σ f = None" 
  note admit = TadmitF_Fun2.hyps(1) and sfree = TadmitF_Fun2.prems(1)
  have IH:"(⋀i. TadmitF σ (args i) ⟹
      sterm_sem I (Tsubst (args i) σ) (fst ν) = sterm_sem (adjoint I σ ν) (args i) (fst ν))" 
    using  TadmitF_Fun2.prems TadmitF_Fun2.IH by auto
  have eqs:"⋀i. sterm_sem I (Tsubst (args i) σ) (fst ν) = sterm_sem (adjoint I σ ν) (args i) (fst ν)"
    by (auto simp add: IH admit)
  show "?case" 
    by(auto simp add: none IH adjoint_def vec_extensionality eqs)
  qed auto

lemma nsubst_dterm':
  fixes I::"('sf, 'sc, 'sz) interp"
  fixes ν::"'sz state"
  assumes good_interp:"is_interp I"    
  shows "TadmitFO σ θ ⟹ dfree θ ⟹ (⋀i. dsafe (σ i)) ⟹ dterm_sem I (TsubstFO θ σ) ν = dterm_sem (adjointFO I σ ν) θ ν"
proof (induction rule: TadmitFO.induct)
  case (TadmitFO_Fun σ args f)
  assume admit:"⋀i. TadmitFO σ (args i)"
  assume IH:"⋀i. dfree (args i) ⟹ (⋀i. dsafe (σ i)) ⟹ dterm_sem I (TsubstFO (args i) σ) ν = dterm_sem (adjointFO I σ ν) (args i) ν"
  assume free:"dfree ($f f args)"
  assume safe:"⋀i. dsafe (σ i)"
  from free have frees: "⋀i. dfree (args i)" by (auto dest: dfree.cases)
  have sem:"⋀i. dterm_sem I (TsubstFO (args i) σ) ν = dterm_sem (adjointFO I σ ν) (args i) ν"
    using IH[OF frees safe] by auto
  have vecEq:" (χ i. dterm_sem (adjointFO I σ ν) (args i) ν) =
   (χ i. dterm_sem
          ⦇Functions = case_sum (Functions I) (λf' _. dterm_sem I (σ f') ν), Predicates = Predicates I, Contexts = Contexts I,
             Programs = Programs I, ODEs = ODEs I, ODEBV = ODEBV I⦈
          (args i) ν) "
    apply(rule vec_extensionality)
    by (auto simp add: adjointFO_def)
  show " dterm_sem I (TsubstFO ($f f args) σ) ν = dterm_sem (adjointFO I σ ν) ($f f args) ν"
    apply (cases "f") 
     apply (auto simp add: vec_extensionality  adjointFO_def)
    using sem apply auto
    subgoal for a using vecEq by auto
    done
next
  case (TadmitFO_Diff σ θ) 
  hence admit:"TadmitFFO σ θ"
    and admitU:"NTUadmit σ θ UNIV"
    (*and IH : "dfree θ ⟹
          (⋀i. dfree (σ i)) ⟹ dterm_sem I (TsubstFO θ σ) ν = dterm_sem (adjointFO I σ ν) θ ν"*)
    and safe: "dfree (Differential θ)" 
    and freeSub:"⋀i. dsafe (σ i)"
    by auto
  from safe have "False" by (auto dest: dfree.cases)
  then show "dterm_sem I (TsubstFO (Differential θ) σ) ν = dterm_sem (adjointFO I σ ν) (Differential θ) ν"
    by auto
qed (auto simp add: TadmitFO.cases)

lemma ntsubst_free_to_safe:
  "dfree θ ⟹ (⋀i. dsafe (σ i)) ⟹ dsafe (TsubstFO θ σ)"
proof (induction rule: dfree.induct) 
  case (dfree_Fun args i) then show "?case"
    by (cases "i") (auto intro:dsafe.intros ntsubst_preserves_free)
qed (auto intro: dsafe.intros)

lemma ntsubst_preserves_safe:
"dsafe θ ⟹ (⋀i. dfree (σ i)) ⟹ dsafe (TsubstFO θ σ)"
proof (induction rule: dsafe.induct) 
  case (dsafe_Fun args i) then show "?case"
    by (cases "i") (auto intro:dsafe.intros ntsubst_preserves_free dfree_is_dsafe)
next
  case (dsafe_Diff θ) then show "?case"
    by  (auto intro:dsafe.intros ntsubst_preserves_free)
qed (auto simp add: ntsubst_preserves_free intro: dsafe.intros)

lemma tsubst_preserves_safe:
"dsafe θ ⟹  (⋀i f'. SFunctions σ i = Some f' ⟹ dfree f') ⟹ dsafe(Tsubst θ σ)"
proof (induction rule: dsafe.induct) 
  case (dsafe_Fun args i) 
  assume dsafes:"⋀i. dsafe (args i)"
  assume IH:"⋀j. (⋀i f'. SFunctions σ i = Some f' ⟹ dfree f') ⟹ dsafe (Tsubst (args j) σ)"
  assume frees:"⋀i f. SFunctions σ i = Some f ⟹ dfree f"
  have IH':"⋀i. dsafe (Tsubst (args i) σ)"
    using frees IH by auto
  then show "?case" 
    apply auto
    apply(cases "SFunctions σ i")
     subgoal using IH frees by auto
    subgoal for a using frees[of i a] ntsubst_free_to_safe[of a] IH' by auto
    done 
qed (auto intro: dsafe.intros tsubst_preserves_free)

lemma subst_dterm:
  fixes I::"('sf, 'sc, 'sz) interp"
  assumes good_interp:"is_interp I"
  shows "
    Tadmit σ θ ⟹
    dsafe θ ⟹
    (⋀i f'. SFunctions σ i = Some f' ⟹ dfree f') ⟹ 
    (⋀f f'. SPredicates σ f = Some f'  ⟹ fsafe f') ⟹
    (⋀ν. dterm_sem I (Tsubst θ σ) ν = dterm_sem (adjoint I σ ν) θ ν)"
proof (induction rule: Tadmit.induct)
  case (Tadmit_Fun1 σ args f f' ν) 
  note safe = Tadmit_Fun1.prems(1) and sfree = Tadmit_Fun1.prems(2) and TA = Tadmit_Fun1.hyps(1)
    and some = Tadmit_Fun1.hyps(2) and NTA = Tadmit_Fun1.hyps(3)
  hence safes:"⋀i. dsafe (args i)" by auto
  have IH:"(⋀ν'. ⋀i. dsafe (args i) ⟹
      dterm_sem I (Tsubst (args i) σ) ν = dterm_sem (adjoint I σ ν) (args i) ν)" 
    using  Tadmit_Fun1.prems Tadmit_Fun1.IH by auto
  have eqs:"⋀i ν'. dterm_sem I (Tsubst (args i) σ) ν = dterm_sem (adjoint I σ ν) (args i) ν"
    by (auto simp add: IH safes)
  let ?sub = "(λ i. Tsubst (args i) σ)"
  have subSafe:"(⋀i. dsafe (?sub i))"
    using tsubst_preserves_safe[OF safes sfree]
    by (simp add: safes sfree tsubst_preserves_safe)
  have freef:"dfree f'" using sfree some by auto 
  have IH2:"dterm_sem I (TsubstFO f' ?sub) ν = dterm_sem (adjointFO I ?sub ν) f' ν"
    by (simp add: nsubst_dterm'[OF good_interp NTA freef subSafe])
  have vec:"(χ i. dterm_sem I (Tsubst (args i) σ) ν) = (χ i. dterm_sem (local.adjoint I σ ν) (args i) ν)"
    apply(auto simp add: vec_eq_iff)
    subgoal for i
      using IH[of i, OF safes[of i]] 
      by auto
    done
  show "?case" 
    using IH safes eqs apply (auto simp add:  IH2  some good_interp)
    using some unfolding adjoint_def adjointFO_def by auto
next
  case (Tadmit_Fun2 σ args f ν) 
  note safe = Tadmit_Fun2.prems(1) and sfree = Tadmit_Fun2.prems(2) and TA = Tadmit_Fun2.hyps(1)
  and none = Tadmit_Fun2.hyps(2) 
  hence safes:"⋀i. dsafe (args i)" by auto
  have IH:"(⋀ν'. ⋀i. dsafe (args i) ⟹
      dterm_sem I (Tsubst (args i) σ) ν = dterm_sem (adjoint I σ ν) (args i) ν)" 
  using  Tadmit_Fun2.prems Tadmit_Fun2.IH by auto
  have Ieq:"Functions I f = Functions (adjoint I σ ν) f"
    using none unfolding adjoint_def by auto
  have vec:"(χ i. dterm_sem I (Tsubst (args i) σ) ν) = (χ i. dterm_sem (adjoint I σ ν) (args i) ν)"
    apply(auto simp add: vec_eq_iff)
    subgoal for i using IH[of i, OF safes[of i]] by auto
    done
  show "?case" using none IH Ieq vec by auto
next
  case (Tadmit_Diff σ θ)  then
  have TA:"Tadmit σ θ"
    and TUA:"TUadmit σ θ UNIV"
    and IH:"dsafe θ ⟹ (⋀i f'. SFunctions σ i = Some f' ⟹ dfree f') ⟹ (⋀ν. dterm_sem I (Tsubst θ σ) ν = dterm_sem (local.adjoint I σ ν) θ ν)"
    and safe:"dsafe (Differential θ)"
    and sfree:"⋀i f'1. SFunctions σ i = Some f'1 ⟹ dfree f'1"
    and spsafe:"⋀f f'. SPredicates σ f = Some f'  ⟹ fsafe f'"
      by auto
  from sfree have sdsafe:"⋀f f'. SFunctions σ f = Some f' ⟹ dsafe f'"
    using dfree_is_dsafe by auto  
  have VA:"⋀ν ω. Vagree ν ω (-UNIV)" unfolding Vagree_def by auto
  from safe have free:"dfree θ" by (auto dest: dsafe.cases intro: dfree.intros)
  from free have tsafe:"dsafe θ" using dfree_is_dsafe by auto
  have freeSubst:"dfree (Tsubst θ σ)" 
    using tsubst_preserves_free[OF free sfree]
    using Tadmit_Diff.prems(2) free tsubst_preserves_free by blast 
  have IH':"⋀ν. dterm_sem I (Tsubst θ σ) ν = dterm_sem (local.adjoint I σ ν) θ ν"
    using IH[OF tsafe sfree] by auto
  have sem_eq:"⋀ν'. dsafe θ ⟹ is_interp I ⟹ dterm_sem (local.adjoint I σ ν) θ = dterm_sem (local.adjoint I σ ν') θ"
    subgoal for ν'
      using uadmit_dterm_adjoint[OF TUA VA sfree spsafe, of "(λ x y. x)" "(λ x y. x)" I ν ν']
      by auto
    done
  have IH'':"⋀ν'. dterm_sem I (Tsubst θ σ) ν' = dterm_sem (local.adjoint I σ ν) θ ν'"
    subgoal for ν'
      using sem_eq[OF tsafe good_interp, of ν'] IH'[of ν'] by auto
    done
  have sem_eq:"sterm_sem I (Tsubst θ σ) = sterm_sem (local.adjoint I σ ν) θ" 
    apply (auto simp add: fun_eq_iff)
    subgoal for ν'
      apply (cases "ν'")
      subgoal for ν''
        apply auto
        using dsem_to_ssem[OF free, of "(local.adjoint I σ ν)" "(ν',ν')"] dsem_to_ssem[OF freeSubst, of I "(ν',ν')"] IH'[of "(ν)"]
        apply auto
        using IH'' by auto
      done
    done
  show "?case"
    apply (auto simp add: directional_derivative_def fun_eq_iff)
    using sterm_determines_frechet[OF 
        good_interp 
        adjoint_safe[OF good_interp sfree] 
        tsubst_preserves_free[OF free sfree] 
        free sem_eq]
    by auto
qed auto  

subsection‹Substitution theorems for ODEs›
lemma osubst_preserves_safe:
  assumes ssafe:"ssafe σ"
  shows "(osafe ODE ⟹ Oadmit σ ODE U ⟹ osafe (Osubst ODE σ))"
proof (induction rule: osafe.induct)
  case (osafe_Var c)
  then show ?case using ssafe unfolding ssafe_def by (cases "SODEs σ c", auto intro: osafe.intros)
next
  case (osafe_Sing θ x)
  then show ?case 
    using tsubst_preserves_free ssafe unfolding ssafe_def by (auto intro: osafe.intros)
next
  case (osafe_Prod ODE1 ODE2)
  moreover have "Oadmit σ ODE1 U" "Oadmit σ ODE2 U" "ODE_dom (Osubst ODE1 σ) ∩  ODE_dom (Osubst ODE2 σ) = {}"
    using osafe_Prod.prems by (auto dest: Oadmit.cases) 
  ultimately show ?case by (auto intro: osafe.intros)
qed

lemma nosubst_preserves_safe:
  assumes sfree:"⋀i. dfree (σ i)"
  fixes α ::"('a + 'd, 'b, 'c) hp" and φ ::"('a + 'd, 'b, 'c) formula"
  shows "(osafe ODE ⟹ OUadmitFO σ ODE U ⟹ osafe (OsubstFO ODE σ))"
proof (induction rule: osafe.induct)
  case (osafe_Var c)
  then show ?case by (auto intro: osafe.intros)
next
  case (osafe_Sing θ x)
  then show ?case using sfree ntsubst_preserves_free[of θ σ] unfolding OUadmitFO_def by (auto intro: osafe.intros)
next
  case (osafe_Prod ODE1 ODE2)
  assume safe1:"osafe ODE1"
    and safe2:"osafe ODE2"
    and disj:"ODE_dom ODE1 ∩ ODE_dom ODE2 = {}"
    and IH1:"OUadmitFO σ ODE1 U ⟹ osafe (OsubstFO ODE1 σ)"
    and IH2:"OUadmitFO σ ODE2 U ⟹ osafe (OsubstFO ODE2 σ)"
    and NOUA:"OUadmitFO σ (OProd ODE1 ODE2) U"    
  have nosubst_preserves_ODE_dom:"⋀ODE. ODE_dom (OsubstFO ODE σ) = ODE_dom ODE"
    subgoal for ODE
      apply(induction "ODE")
        by auto
    done
  have disj':"ODE_dom (OsubstFO ODE1 σ) ∩ ODE_dom (OsubstFO ODE2 σ) = {}"
    using disj nosubst_preserves_ODE_dom by auto
  from NOUA have NOUA1:"OUadmitFO σ ODE1 U" and NOUA2:"OUadmitFO σ  ODE2 U"  unfolding OUadmitFO_def by auto
  then show ?case using IH1[OF NOUA1] IH2[OF NOUA2] disj' by (auto intro: osafe.intros)
qed

lemma nsubst_dterm:
  fixes I::"('sf, 'sc, 'sz) interp"
  fixes ν::"'sz state"
  fixes ν'::"'sz state"
  assumes good_interp:"is_interp I"    
  shows "TadmitFO σ θ ⟹ dsafe θ ⟹ (⋀i. dsafe (σ i)) ⟹ dterm_sem I (TsubstFO θ σ) ν = dterm_sem (adjointFO I σ ν) θ ν"
proof (induction rule: TadmitFO.induct)
  case (TadmitFO_Diff σ θ) then
  have subFree:"(⋀i. dsafe (σ i))"
    and  NTFA:"TadmitFFO σ θ"
    and substFree:"dfree (TsubstFO θ σ)"
    and dsafe:"dsafe (Differential θ)"
    and subSafe:"⋀i. dsafe (σ i)"
    and  NTU:"NTUadmit σ θ UNIV"  
    by auto   
  have dfree:"dfree θ" using dsafe by auto
  then show ?case
    apply auto
    apply (unfold directional_derivative_def) 
    apply (rule sterm_determines_frechet)
    subgoal using good_interp by auto
       subgoal using adjointFO_safe[OF good_interp, of σ] subSafe by auto
      subgoal  using substFree by auto
     subgoal using dfree by auto
    subgoal
      apply(rule ext)
      subgoal for x
        using nsubst_sterm'[of  σ θ I "(fst ν)" "(snd ν)", OF NTFA subSafe] apply auto
      proof -
        assume sem:"sterm_sem I (TsubstFO θ σ) (fst ν) = sterm_sem (adjointFO I σ ν) θ (fst ν)"
        have VA:"⋀ν ω. Vagree ν (x,snd ν) (-UNIV)" unfolding Vagree_def by auto
        show "sterm_sem I (TsubstFO θ σ) x = sterm_sem (adjointFO I σ ν) θ x"
          using uadmit_sterm_ntadjoint[OF NTU VA subSafe, OF  good_interp, of "(x, snd ν)"]
            nsubst_sterm[OF NTFA subSafe, of I ν ] 
          apply auto
          using NTU VA dfree_is_dsafe  dsafe subSafe substFree good_interp uadmit_sterm_ntadjoint
          by (metis NTFA fst_eqD nsubst_sterm)
      qed
    done
  done
next
  case (TadmitFO_Fun σ args f)
  then show ?case apply auto apply(cases f) unfolding adjointFO_def by auto
qed (auto)
  
lemma nsubst_ode:
  fixes I::"('sf, 'sc, 'sz) interp"
  fixes ν::"'sz state"
  fixes ν'::"'sz state"
  assumes good_interp:"is_interp I"    
  shows "osafe ODE ⟹ OadmitFO σ ODE U ⟹ (⋀i. dsafe (σ i)) ⟹ ODE_sem I (OsubstFO ODE σ) (fst ν)= ODE_sem (adjointFO I σ ν) ODE (fst ν)"
proof (induction rule: osafe.induct)
  case (osafe_Var c)
  then show ?case unfolding OUadmitFO_def adjointFO_def by auto
next
  case (osafe_Sing θ x)
  then show ?case apply auto
    using nsubst_sterm' [of  σ θ I "(fst ν)" "(snd ν)"] by auto
next
  case (osafe_Prod ODE1 ODE2) then
  have NO1:"OadmitFO σ ODE1 U" and NO2:"OadmitFO σ ODE2 U" 
    unfolding OUadmitFO_def by auto
  have "ODE_sem I (OsubstFO ODE1 σ) (fst ν) = ODE_sem (adjointFO I σ ν) ODE1 (fst ν)"
    "ODE_sem I (OsubstFO ODE2 σ) (fst ν) = ODE_sem (adjointFO I σ ν) ODE2 (fst ν)" using osafe_Prod.IH osafe_Prod.prems osafe_Prod.hyps
    using NO1 NO2 by auto
  then show ?case by auto
qed
    
lemma osubst_preserves_BVO:
  shows "BVO (OsubstFO ODE σ) = BVO ODE"
proof (induction "ODE")
qed (auto)

lemma osubst_preserves_ODE_vars:
  shows "ODE_vars I (OsubstFO ODE σ) = ODE_vars (adjointFO I σ ν) ODE"
proof (induction "ODE")
qed (auto simp add: adjointFO_def)

lemma osubst_preserves_semBV:
  shows "semBV I (OsubstFO ODE σ) = semBV (adjointFO I σ ν) ODE"
proof (induction "ODE")
qed (auto simp add: adjointFO_def)

lemma nsubst_mkv:
  fixes I::"('sf, 'sc, 'sz) interp"
  fixes ν::"'sz state"
  fixes ν'::"'sz state"
  assumes good_interp:"is_interp I"  
  assumes NOU:"OadmitFO σ ODE U"
  assumes osafe:"osafe ODE "
  assumes frees:"(⋀i. dsafe (σ i))"
  shows "(mk_v I (OsubstFO ODE σ) ν (fst ν')) 
    = (mk_v (adjointFO I σ ν') ODE ν (fst ν'))"
  apply(rule agree_UNIV_eq)
  using mk_v_agree[of "adjointFO I σ ν'" "ODE" ν "fst ν'"]
  using mk_v_agree[of "I" "OsubstFO ODE σ" ν "fst ν'"] 
  unfolding Vagree_def 
  using nsubst_ode[OF good_interp osafe NOU frees, of ν']
  apply auto
   subgoal for i
     apply(erule allE[where x=i])+
     apply(cases "Inl i ∈ semBV I (OsubstFO ODE σ)")
      using  osubst_preserves_ODE_vars
      by (metis (full_types))+
  subgoal for i
    apply(erule allE[where x=i])+
    apply(cases "Inr i ∈ BVO ODE")
     using  osubst_preserves_ODE_vars
     by (metis (full_types))+
  done

lemma ODE_unbound_zero:
  fixes i
  shows "Inl i ∉ BVO ODE ⟹ ODE_sem I ODE x $ i = 0"
proof (induction ODE)
qed (auto)

lemma ODE_bound_effect:
  fixes s t sol ODE X b
  assumes s:"s ∈ {0..t}"
  assumes sol:"(sol solves_ode (λ_. ODE_sem I ODE)) {0..t}  X"
  shows "Vagree (sol 0,b) (sol s, b) (-(BVO ODE))"
proof -
  have "⋀i. Inl i ∉ BVO ODE ⟹  (∀ s. s ∈ {0..t} ⟶ sol s $ i = sol 0 $ i)"
    apply auto
    apply (rule constant_when_zero)
         using s sol apply auto
    using ODE_unbound_zero solves_ode_subset 
    by fastforce+
  then show "Vagree (sol 0, b) (sol s, b) (- BVO ODE)"
    unfolding Vagree_def 
    using s  by (metis Compl_iff fst_conv  snd_conv)
qed

lemma NO_sub:"OadmitFO σ ODE A ⟹ B ⊆ A ⟹ OadmitFO σ ODE B"
  by(induction ODE, auto simp add: OUadmitFO_def)

lemma NO_to_NOU:"OadmitFO σ ODE S ⟹ OUadmitFO σ ODE S"
  by(induction ODE, auto simp add: OUadmitFO_def)
  
subsection‹Substitution theorems for formulas and programs›
lemma nsubst_hp_fml:
  fixes I::"('sf, 'sc, 'sz) interp"
  assumes good_interp:"is_interp I"    
  shows " (NPadmit σ α ⟶ (hpsafe α ⟶ (∀i. dsafe (σ i)) ⟶ (∀ ν ω. ((ν, ω) ∈ prog_sem I (PsubstFO α σ)) = ((ν, ω) ∈ prog_sem (adjointFO I σ ν) α)))) ∧
    (NFadmit σ φ ⟶ (fsafe φ ⟶ (∀i. dsafe (σ i)) ⟶ (∀ ν. (ν ∈ fml_sem I (FsubstFO φ σ)) = (ν ∈ fml_sem (adjointFO I σ ν) φ))))"
proof (induction rule: NPadmit_NFadmit.induct)
  case (NPadmit_Pvar σ a)
  then show ?case unfolding adjointFO_def by auto
next
  case (NPadmit_ODE σ ODE φ) then
  have  NOU:"OadmitFO σ ODE (BVO ODE)"
    and NFA:"NFadmit σ φ"
    and NFU:"FUadmitFO σ φ (BVO ODE)"
    and fsafe:"fsafe (FsubstFO φ σ)"
    and IH:"fsafe φ ⟹ (⋀i. dsafe (σ i)) ⟹ (⋀ν. (ν ∈ fml_sem I (FsubstFO φ σ)) = (ν ∈ fml_sem (adjointFO I σ ν) φ))"
    and osafe':"osafe (OsubstFO ODE σ)"
      by auto
  have "hpsafe (EvolveODE ODE φ) ⟹  (⋀i. dsafe (σ i)) ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (PsubstFO (EvolveODE ODE φ) σ)) = ((ν, ω) ∈ prog_sem (adjointFO I σ ν) (EvolveODE ODE φ)))"
  proof -
    assume safe:"hpsafe (EvolveODE ODE φ)"
    then have osafe:"osafe ODE" and fsafe:"fsafe φ" by auto
    assume frees:"(⋀i. dsafe (σ i))"
    fix ν ω
    show "((ν, ω) ∈ prog_sem I (PsubstFO (EvolveODE ODE φ) σ)) = ((ν, ω) ∈ prog_sem (adjointFO I σ ν) (EvolveODE ODE φ))"
    proof (auto)
      fix b 
        and sol :: "real ⇒(real, 'sz) vec" 
        and t :: real
      assume eq1:"ν = (sol 0, b)"
      assume eq2:"ω = mk_v I (OsubstFO ODE σ) (sol 0, b) (sol t)"
      assume t:"0 ≤ t"
      assume sol:"(sol solves_ode (λa. ODE_sem I (OsubstFO ODE σ))) {0..t} 
         {x. mk_v I (OsubstFO ODE σ) (sol 0, b) x ∈ fml_sem I (FsubstFO φ σ)}"
      have agree_sem:"⋀t. Vagree (mk_v I (OsubstFO ODE σ) (sol 0, b) (sol t)) (sol 0, b) (- (Inl ` ODE_vars I (OsubstFO ODE σ) ∪ Inr ` ODE_vars I (OsubstFO ODE σ)))"
        subgoal for t
          using mk_v_agree[of I "OsubstFO ODE σ" "(sol 0, b)" "sol t"] unfolding Vagree_def apply auto
          done
        done
      have bv_sub:"(-BVO ODE) ⊆ - (Inl ` ODE_vars I (OsubstFO ODE σ) ∪ Inr ` ODE_vars I (OsubstFO ODE σ))"
        by(induction ODE, auto) 
      have agree:"⋀t. Vagree (mk_v I (OsubstFO ODE σ) (sol 0, b) (sol t)) (sol 0, b) (- BVO ODE)"
        using agree_sub[OF bv_sub agree_sem] by auto
      ― ‹Necessary›
      have mkv:"⋀t. mk_v I (OsubstFO ODE σ) (sol 0, b) (sol t) = mk_v (adjointFO I σ (sol t, b)) ODE (sol 0, b) (sol t)"
        using nsubst_mkv[OF good_interp NOU osafe frees]
        by auto
      have hmm:"⋀s. s ∈ {0..t} ⟹ Vagree (sol 0,b) (sol s, b) (-(BVO ODE))"
        using ODE_bound_effect sol
        by (metis osubst_preserves_BVO)
      have FVT_sub:"(⋃y∈{y. Inl (Inr y) ∈ SIGO ODE}. FVT (σ y)) ⊆ (-(BVO ODE))"
        using NOU NO_to_NOU OUadmitFO_def 
        by fastforce
      have agrees:"⋀s. s ∈ {0..t} ⟹ Vagree (sol 0,b) (sol s, b) (⋃y∈{y. Inl (Inr y) ∈ SIGO ODE}. FVT (σ y))" 
        subgoal for s using agree_sub[OF FVT_sub hmm[of s]] by auto done
      have "⋀s. s ∈ {0..t} ⟹ mk_v (adjointFO I σ (sol s, b)) ODE  = mk_v (adjointFO I σ (sol 0, b)) ODE"
        subgoal for s
          apply (rule uadmit_mkv_ntadjoint)
             prefer 3
             using NOU hmm[of s] NO_to_NOU unfolding OUadmitFO_def Vagree_def
             apply fastforce   
            using frees good_interp osafe by auto
        done
      then have mkva:"⋀s. s ∈ {0..t} ⟹ mk_v (adjointFO I σ (sol s, b)) ODE (sol 0, b) (sol s) = mk_v (adjointFO I σ (sol 0, b)) ODE (sol 0, b) (sol s)"
        by presburger
      have main_eq:"⋀s. s ∈ {0..t} ⟹  mk_v I (OsubstFO ODE σ) (sol 0, b) (sol s) = mk_v (adjointFO I σ (sol 0, b)) ODE (sol 0, b) (sol s) "
        using mkv mkva by auto
      note mkvt = main_eq[of t]
      have fml_eq1:"⋀s. s ∈ {0..t} ⟹ 
          (mk_v I (OsubstFO ODE σ) (sol 0, b) (sol s) ∈ fml_sem I (FsubstFO φ σ)) 
        = (mk_v I (OsubstFO ODE σ) (sol 0, b) (sol s) ∈ fml_sem (adjointFO I σ (mk_v I (OsubstFO ODE σ) (sol 0, b) (sol s))) φ)"
        using IH[OF fsafe frees] by auto
      have fml_eq2:"⋀s. s ∈ {0..t} ⟹ 
        ((mk_v I (OsubstFO ODE σ) (sol 0, b) (sol s) ∈ fml_sem (adjointFO I σ (mk_v I (OsubstFO ODE σ) (sol 0, b) (sol s))) φ)
        =(mk_v I (OsubstFO ODE σ) (sol 0, b) (sol s) ∈ fml_sem (adjointFO I σ (sol 0, b)) φ))"
        subgoal for s
          using NFU frees fsafe good_interp mk_v_agree osubst_preserves_ODE_vars uadmit_fml_ntadjoint
          using agree by blast
        done
      have fml_eq3:"⋀s. s ∈ {0..t} ⟹
        (mk_v I (OsubstFO ODE σ) (sol 0, b) (sol s) ∈ fml_sem (adjointFO I σ (sol 0, b)) φ) = (mk_v (adjointFO I σ (sol 0,b)) ODE (sol 0, b) (sol s) ∈ fml_sem (adjointFO I σ (sol 0, b)) φ) "
        using main_eq by auto
      have fml_eq: "⋀s. s ∈ {0..t} ⟹
         (mk_v I (OsubstFO ODE σ) (sol 0, b) (sol s) ∈ fml_sem I (FsubstFO φ σ)) 
          =  (mk_v (adjointFO I σ (sol 0,b)) ODE (sol 0, b) (sol s) ∈ fml_sem (adjointFO I σ (sol 0, b)) φ)"
        using fml_eq1 fml_eq2 fml_eq3 by meson
      have sem_eq:"⋀t. ODE_sem I (OsubstFO ODE σ) (sol t) = ODE_sem (adjointFO I σ (sol t, b)) ODE (sol t)"
        subgoal for t
          using nsubst_ode[OF good_interp osafe NOU frees, of "(sol t,b)"] by auto
        done
      have sem_fact:"⋀s. s ∈ {0..t} ⟹ ODE_sem I (OsubstFO ODE σ) (sol s) = ODE_sem (adjointFO I σ (sol 0, b)) ODE (sol s)"
        subgoal for s
          using nsubst_ode[OF good_interp osafe NOU frees, of "(sol s, b)"]
          uadmit_ode_ntadjoint'[OF frees good_interp agrees[of s] osafe]
          by auto
        done
      have sol':"(sol solves_ode (λ_. ODE_sem (adjointFO I σ (sol 0, b)) ODE)) {0..t}
         {x. mk_v I (OsubstFO ODE σ) (sol 0, b) x ∈ fml_sem I (FsubstFO φ σ)}"
        apply (rule solves_ode_congI)
            apply (rule sol)
           subgoal for ta by auto
          subgoal for ta by (rule sem_fact[of ta])
         subgoal by (rule refl)
        subgoal by (rule refl)
        done
      have sub:"⋀s. s ∈ {0..t} 
              ⟹ sol s ∈ {x. (mk_v (adjointFO I σ (sol 0,b)) ODE (sol 0, b) x ∈ fml_sem (adjointFO I σ (sol 0, b)) φ)}"
        using fml_eq rangeI t sol solves_ode_domainD by fastforce
      have sol'':"(sol solves_ode (λc. ODE_sem (adjointFO I σ (sol 0, b)) ODE)) {0..t}
 {x. mk_v (adjointFO I σ (sol 0, b)) ODE (sol 0, b) x ∈ fml_sem (adjointFO I σ (sol 0, b)) φ}"
        apply (rule solves_odeI)
         subgoal using sol' solves_ode_vderivD by blast
        using sub by auto
      show "∃sola. sol 0 = sola 0 ∧
          (∃ta. mk_v I (OsubstFO ODE σ) (sol 0, b) (sol t) = mk_v (adjointFO I σ (sol 0, b)) ODE (sola 0, b) (sola ta) ∧
                0 ≤ ta ∧
                (sola solves_ode (λa. ODE_sem (adjointFO I σ (sol 0, b)) ODE)) {0..ta}
                 {x. mk_v (adjointFO I σ (sol 0, b)) ODE (sola 0, b) x ∈ fml_sem (adjointFO I σ (sol 0, b)) φ})"
        apply(rule exI[where x=sol])
        apply(rule conjI)
         subgoal by (rule refl)
        apply(rule exI[where x=t])
        apply(rule conjI)
         subgoal using  mkvt t by auto
        apply(rule conjI)
         subgoal by (rule t)
        subgoal by (rule sol'') 
        done
  next
    fix b 
      and sol::"real ⇒ (real, 'sz) vec" 
      and t::real
    assume eq1:"ν = (sol 0, b)"
    assume eq2:"ω = mk_v (adjointFO I σ (sol 0, b)) ODE (sol 0, b) (sol t)"
    assume t:"0 ≤ t"
    assume sol:"(sol solves_ode (λa. ODE_sem (adjointFO I σ (sol 0, b)) ODE)) {0..t}
     {x. mk_v (adjointFO I σ (sol 0, b)) ODE (sol 0, b) x ∈ fml_sem (adjointFO I σ (sol 0, b)) φ}"
    have agree_sem:"⋀t. Vagree (mk_v I (OsubstFO ODE σ) (sol 0, b) (sol t)) (sol 0, b) (- (Inl ` ODE_vars I (OsubstFO ODE σ) ∪ Inr ` ODE_vars I (OsubstFO ODE σ)))"
      subgoal for t
        using mk_v_agree[of I "OsubstFO ODE σ" "(sol 0, b)" "sol t"] unfolding Vagree_def apply auto
        done
      done
    have bv_sub:"(-BVO ODE) ⊆ - (Inl ` ODE_vars I (OsubstFO ODE σ) ∪ Inr ` ODE_vars I (OsubstFO ODE σ))"
      by(induction ODE, auto) 
    have agree:"⋀t. Vagree (mk_v I (OsubstFO ODE σ) (sol 0, b) (sol t)) (sol 0, b) (- BVO ODE)"
      using agree_sub[OF bv_sub agree_sem] by auto
    ― ‹Necessary›
    have mkv:"⋀t. mk_v I (OsubstFO ODE σ) (sol 0, b) (sol t) = mk_v (adjointFO I σ (sol t, b)) ODE (sol 0, b) (sol t)"
      using nsubst_mkv[OF good_interp NOU osafe frees]
      by auto
    have hmm:"⋀s. s ∈ {0..t} ⟹ Vagree (sol 0,b) (sol s, b) (-(BVO ODE))"
      using ODE_bound_effect sol
      by (metis osubst_preserves_ODE_vars)
    have FVT_sub:"(⋃y∈{y. Inl (Inr y) ∈ SIGO ODE}. FVT (σ y)) ⊆ (-(BVO ODE))"
      using NOU NO_to_NOU unfolding OUadmitFO_def by fastforce
    have agrees:"⋀s. s ∈ {0..t} ⟹ Vagree (sol 0,b) (sol s, b) (⋃y∈{y. Inl (Inr y) ∈ SIGO ODE}. FVT (σ y))" 
      subgoal for s using agree_sub[OF FVT_sub hmm[of s]] by auto done
    have "⋀s. s ∈ {0..t} ⟹ mk_v (adjointFO I σ (sol s, b)) ODE  = mk_v (adjointFO I σ (sol 0, b)) ODE"
      subgoal for s
        apply (rule uadmit_mkv_ntadjoint)
           prefer 3
           using NOU hmm[of s] NO_to_NOU unfolding OUadmitFO_def Vagree_def
           apply fastforce   
          using frees good_interp osafe by auto
        done
    then have mkva:"⋀s. s ∈ {0..t} ⟹ mk_v (adjointFO I σ (sol s, b)) ODE (sol 0, b) (sol s) = mk_v (adjointFO I σ (sol 0, b)) ODE (sol 0, b) (sol s)"
      by presburger
    have main_eq:"⋀s. s ∈ {0..t} ⟹  mk_v I (OsubstFO ODE σ) (sol 0, b) (sol s) = mk_v (adjointFO I σ (sol 0, b)) ODE (sol 0, b) (sol s) "
      using mkv mkva by auto
    note mkvt = main_eq[of t]
    have fml_eq1:"⋀s. s ∈ {0..t} ⟹ 
        (mk_v I (OsubstFO ODE σ) (sol 0, b) (sol s) ∈ fml_sem I (FsubstFO φ σ)) 
      = (mk_v I (OsubstFO ODE σ) (sol 0, b) (sol s) ∈ fml_sem (adjointFO I σ (mk_v I (OsubstFO ODE σ) (sol 0, b) (sol s))) φ)"
      using IH[OF fsafe frees] by auto
    have fml_eq2:"⋀s. s ∈ {0..t} ⟹ 
      ((mk_v I (OsubstFO ODE σ) (sol 0, b) (sol s) ∈ fml_sem (adjointFO I σ (mk_v I (OsubstFO ODE σ) (sol 0, b) (sol s))) φ)
      =(mk_v I (OsubstFO ODE σ) (sol 0, b) (sol s) ∈ fml_sem (adjointFO I σ (sol 0, b)) φ))"
        using  NFU frees fsafe good_interp mk_v_agree osubst_preserves_ODE_vars uadmit_fml_ntadjoint agree by blast
      
    have fml_eq3:"⋀s. s ∈ {0..t} ⟹
     (mk_v I (OsubstFO ODE σ) (sol 0, b) (sol s) ∈ fml_sem (adjointFO I σ (sol 0, b)) φ) = (mk_v (adjointFO I σ (sol 0,b)) ODE (sol 0, b) (sol s) ∈ fml_sem (adjointFO I σ (sol 0, b)) φ) "
     using main_eq by auto
    have fml_eq: "⋀s. s ∈ {0..t} ⟹
      (mk_v I (OsubstFO ODE σ) (sol 0, b) (sol s) ∈ fml_sem I (FsubstFO φ σ)) 
       =  (mk_v (adjointFO I σ (sol 0,b)) ODE (sol 0, b) (sol s) ∈ fml_sem (adjointFO I σ (sol 0, b)) φ)"
      using fml_eq1 fml_eq2 fml_eq3 by meson
     have sem_eq:"⋀t. ODE_sem I (OsubstFO ODE σ) (sol t) = ODE_sem (adjointFO I σ (sol t, b)) ODE (sol t)"
       subgoal for t
         using nsubst_ode[OF good_interp osafe NOU frees, of "(sol t,b)"] by auto
       done
    have sem_fact:"⋀s. s ∈ {0..t} ⟹ ODE_sem I (OsubstFO ODE σ) (sol s) = ODE_sem (adjointFO I σ (sol 0, b)) ODE (sol s)"
      subgoal for s
        using nsubst_ode[OF good_interp osafe NOU frees, of "(sol s, b)"]
        uadmit_ode_ntadjoint'[OF frees good_interp agrees[of s] osafe]
        by auto
      done
    have sol':"
      (sol solves_ode (λa. ODE_sem I (OsubstFO ODE σ))) {0..t}  {x. mk_v (adjointFO I σ (sol 0, b)) ODE (sol 0, b) x ∈ fml_sem (adjointFO I σ (sol 0, b)) φ}"
      apply (rule solves_ode_congI)
          apply (rule sol)
         subgoal for ta by auto
        subgoal for ta using sem_fact[of ta] by auto
       subgoal by (rule refl)
      subgoal by (rule refl)
      done
    have sub:"⋀s. s ∈ {0..t} 
            ⟹ sol s ∈ {x. (mk_v (adjointFO I σ (sol 0,b)) ODE (sol 0, b) x ∈ fml_sem (adjointFO I σ (sol 0, b)) φ)}"
      using fml_eq rangeI t sol solves_ode_domainD by fastforce
    have sol'':"(sol solves_ode (λa. ODE_sem I (OsubstFO ODE σ))) {0..t} {x. mk_v I (OsubstFO ODE σ) (sol 0, b) x ∈ fml_sem I (FsubstFO φ σ)}"
      apply (rule solves_odeI)
       subgoal using sol' solves_ode_vderivD by blast
      using sub fml_eq by blast
    show "∃sola. sol 0 = sola 0 ∧
          (∃ta. mk_v (adjointFO I σ (sol 0, b)) ODE (sol 0, b) (sol t) = mk_v I (OsubstFO ODE σ) (sola 0, b) (sola ta) ∧
                0 ≤ ta ∧
                (sola solves_ode (λa. ODE_sem I (OsubstFO ODE σ))) {0..ta} {x. mk_v I (OsubstFO ODE σ) (sola 0, b) x ∈ fml_sem I (FsubstFO φ σ)})"
      apply(rule exI[where x=sol])
      apply(rule conjI)
       subgoal by (rule refl)
      apply(rule exI[where x=t])
      apply(rule conjI)
       subgoal using t mkvt by auto
      apply(rule conjI)
       subgoal by (rule t)
      subgoal by (rule sol'')
      done
    qed
  qed
  then show ?case by auto 
next
  case (NPadmit_Assign σ θ x)
  then show ?case using nsubst_dterm[OF good_interp, of σ θ] by auto
next
  case (NPadmit_DiffAssign σ θ x)
  then show ?case using nsubst_dterm[OF good_interp, of σ θ] by auto
next
  case (NFadmit_Geq σ θ1 θ2)
  then show ?case 
    using nsubst_dterm[OF good_interp, of σ θ1] 
    using nsubst_dterm[OF good_interp, of σ θ2] by auto
next
  case (NFadmit_Prop σ args f)
  assume NTA:"⋀i. TadmitFO σ (args i)"
  have "⋀ν.  fsafe ($φ f args) ⟹  (⋀i. dsafe (σ i)) ⟹ (ν ∈ fml_sem I (FsubstFO ($φ f args) σ)) = (ν ∈ fml_sem (adjointFO I σ ν) ($φ f args))"
  proof -
    fix ν
    assume safe:"fsafe ($φ f args)"
    from safe have safes:"⋀i. dsafe (args i)" using dfree_is_dsafe by auto
    assume subFree:"(⋀i. dsafe (σ i))"
    have vec_eq:"(χ i. dterm_sem (adjointFO I σ ν) (args i) ν) = (χ i. dterm_sem I (TsubstFO (args i) σ) ν)"
      apply(rule vec_extensionality)
      using nsubst_dterm[OF good_interp NTA safes subFree] by auto
    then show "?thesis ν" unfolding adjointFO_def by auto
  qed
  then show ?case by auto 
next
  case (NPadmit_Sequence σ a b) then 
  have PUA:"PUadmitFO σ b (BVP (PsubstFO a σ))"
    and PA:"NPadmit σ a"
    and IH1:"hpsafe a ⟹ (⋀i. dsafe (σ i)) ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (PsubstFO a σ)) = ((ν, ω) ∈ prog_sem (adjointFO I σ ν) a))"
    and IH2:"hpsafe b ⟹ (⋀i. dsafe (σ i)) ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (PsubstFO b σ)) = ((ν, ω) ∈ prog_sem (adjointFO I σ ν) b))"
    and hpsafeS:"hpsafe (PsubstFO a σ)"
     by auto
  have "hpsafe (a ;; b) ⟹ (⋀i. dsafe (σ i)) ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (PsubstFO (a ;; b) σ)) = ((ν, ω) ∈ prog_sem (adjointFO I σ ν) (a ;; b)))"
  proof -
    assume hpsafe:"hpsafe (a ;; b)"
    assume ssafe:"(⋀i. dsafe (σ i))"
    from hpsafe have safe1:"hpsafe a" and safe2:"hpsafe b" by (auto dest: hpsafe.cases)
    fix ν ω
    have agree:"⋀μ. (ν, μ) ∈ prog_sem I (PsubstFO a σ) ⟹ Vagree ν μ (-BVP(PsubstFO a σ))"
      subgoal for μ
        using bound_effect[OF good_interp, of "(PsubstFO a σ)" ν , OF hpsafeS] by auto
      done
    have sem_eq:"⋀μ. (ν, μ) ∈ prog_sem I (PsubstFO a σ) ⟹ 
        ((μ, ω) ∈ prog_sem (adjointFO I σ ν) b) =
        ((μ, ω) ∈ prog_sem (adjointFO I σ μ) b)"
      subgoal for μ
      proof -
        assume assm:"(ν, μ) ∈ prog_sem I (PsubstFO a σ)"
        show "((μ, ω) ∈ prog_sem (adjointFO I σ ν) b) = ((μ, ω) ∈ prog_sem (adjointFO I σ μ) b)"
          using uadmit_prog_ntadjoint [OF PUA agree[OF assm] ssafe safe2 good_interp] 
          by auto
      qed
      done      
    have "((ν, ω) ∈ prog_sem I (PsubstFO (a ;; b) σ)) = (∃ μ. (ν, μ) ∈ prog_sem I (PsubstFO a σ) ∧ (μ, ω) ∈ prog_sem I (PsubstFO b σ))"
      by auto
    moreover have "... = (∃ μ. (ν, μ) ∈ prog_sem I (PsubstFO a σ) ∧ (μ, ω) ∈ prog_sem (adjointFO I σ μ) b)"
      using IH2[OF safe2 ssafe] by auto
    moreover have "... = (∃ μ. (ν, μ) ∈ prog_sem I (PsubstFO a σ) ∧ (μ, ω) ∈ prog_sem (adjointFO I σ ν) b)"
      using sem_eq by auto
    moreover have "... = (∃ μ. (ν, μ) ∈ prog_sem (adjointFO I σ ν) a ∧ (μ, ω) ∈ prog_sem (adjointFO I σ ν) b)"
      using IH1[OF safe1 ssafe] by auto
    ultimately
    show "((ν, ω) ∈ prog_sem I (PsubstFO (a ;; b) σ)) = ((ν, ω) ∈ prog_sem (adjointFO I σ ν) (a ;; b))"
      by auto
  qed
  then show ?case by auto
next
  case (NPadmit_Loop σ a) then 
  have PA:"NPadmit σ a"
    and PUA:"PUadmitFO σ a (BVP (PsubstFO a σ))"
    and IH:"hpsafe a ⟹ (⋀i. dsafe (σ i)) ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (PsubstFO a σ)) = ((ν, ω) ∈ prog_sem (adjointFO I σ ν) a))"
    and hpsafeS:"hpsafe (PsubstFO a σ)"
      by auto
  have "hpsafe (a**) ⟹ (⋀i. dsafe (σ i)) ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (PsubstFO (a**) σ)) = ((ν, ω) ∈ prog_sem (adjointFO I σ ν) (a**)))"
  proof -
    assume "hpsafe (a**)"
    then have hpsafe:"hpsafe a" by (auto dest: hpsafe.cases)
    assume ssafe:"(⋀i. dsafe (σ i))"
    have agree:"⋀ν μ. (ν, μ) ∈ prog_sem I (PsubstFO a σ) ⟹ Vagree ν μ (-BVP(PsubstFO a σ))"
      subgoal for ν μ
        using bound_effect[OF good_interp, of "(PsubstFO a σ)" ν, OF hpsafeS] 
        by auto
      done
    have sem_eq:"⋀ν μ ω. (ν, μ) ∈ prog_sem I (PsubstFO a σ) ⟹ 
        ((μ, ω) ∈ prog_sem (adjointFO I σ ν) a) =
        ((μ, ω) ∈ prog_sem (adjointFO I σ μ) a)"
      subgoal for ν μ ω 
        proof -
          assume assm:"(ν, μ) ∈ prog_sem I (PsubstFO a σ)"
          show "((μ, ω) ∈ prog_sem (adjointFO I σ ν) a) = ((μ, ω) ∈ prog_sem (adjointFO I σ μ) a)"
            using uadmit_prog_ntadjoint[OF PUA agree[OF assm] ssafe hpsafe  good_interp] by auto
        qed
      done 
    fix ν ω
    have UN_rule:"⋀ a S S'. (⋀n b. (a,b) ∈ S n ⟷ (a,b) ∈ S' n) ⟹ (⋀b. (a,b) ∈ (⋃n. S n) ⟷ (a,b) ∈ (⋃n. S' n))"
      by auto
    have eqL:"((ν, ω) ∈ prog_sem I (PsubstFO (a**) σ)) = ((ν, ω) ∈ (⋃n. (prog_sem I (PsubstFO a σ)) ^^ n))"
      using rtrancl_is_UN_relpow by auto
    moreover have eachEq:"⋀n. ((⋀ν ω. ((ν, ω) ∈ (prog_sem I (PsubstFO a σ)) ^^ n) = ((ν, ω) ∈ (prog_sem (adjointFO I σ ν) a)^^ n)))"
    proof -
      fix n
      show "((⋀ν ω. ((ν, ω) ∈ (prog_sem I (PsubstFO a σ)) ^^ n) = ((ν, ω) ∈ (prog_sem (adjointFO I σ ν) a)^^ n)))"
      proof (induct n)
        case 0
        then show ?case by auto
      next
        case (Suc n) then
        have IH2:"⋀ν ω. ((ν, ω) ∈ prog_sem I (PsubstFO a σ) ^^ n) = ((ν, ω) ∈ prog_sem (adjointFO I σ ν) a ^^ n)"
          by auto
        have relpow:"⋀R n. R ^^ Suc n = R O R ^^ n"
          using relpow.simps(2) relpow_commute by metis
        show ?case 
          apply (simp only: relpow[of n "prog_sem I (PsubstFO a σ)"] relpow[of n "prog_sem (adjointFO I σ ν) a"])
          apply(unfold relcomp_unfold)
          apply auto
           subgoal for ab b
             apply(rule exI[where x=ab])
             apply(rule exI[where x=b])
             using IH2 IH[OF hpsafe ssafe] sem_eq[of ν "(ab,b)" ω] apply auto
              using uadmit_prog_ntadjoint[OF PUA agree ssafe hpsafe good_interp] IH[OF hpsafe ssafe]
              apply (metis (no_types, lifting)) 
             using uadmit_prog_ntadjoint[OF PUA agree ssafe hpsafe good_interp] IH[OF hpsafe ssafe]
             apply (metis (no_types, lifting)) 
           done
          subgoal for ab b
            apply(rule exI[where x=ab])
            apply(rule exI[where x=b])
            using IH2 IH[OF hpsafe ssafe] sem_eq[of ν "(ab,b)" ω] apply auto
             using uadmit_prog_ntadjoint[OF PUA agree ssafe hpsafe good_interp] IH[OF hpsafe ssafe]
             apply (metis (no_types, lifting))
            using uadmit_prog_ntadjoint[OF PUA agree ssafe hpsafe good_interp] IH[OF hpsafe ssafe]
            apply (metis (no_types, lifting))
          done
        done
      qed
      qed
    moreover have "((ν, ω) ∈ (⋃n. (prog_sem I (PsubstFO a σ)) ^^ n)) = ((ν, ω) ∈ (⋃ n.(prog_sem (adjointFO I σ ν) a)^^ n))"
      apply(rule UN_rule)
      using eachEq by auto
    moreover have eqR:"((ν, ω) ∈ prog_sem (adjointFO I σ ν) (a**)) = ((ν, ω) ∈ (⋃n. (prog_sem (adjointFO I σ ν) a) ^^ n))"
       using rtrancl_is_UN_relpow by auto
    ultimately show "((ν, ω) ∈ prog_sem I (PsubstFO (a**) σ)) = ((ν, ω) ∈ prog_sem (adjointFO I σ ν) (a**))"
      by auto
  qed
  then show ?case by auto
next
  case (NFadmit_Exists σ φ x)
  then have IH:"fsafe φ ⟹ (⋀i. dsafe (σ i)) ⟹ (⋀ν. (ν ∈ fml_sem I (FsubstFO φ σ)) = (ν ∈ fml_sem (adjointFO I σ ν) φ))"
    and FUA:"FUadmitFO σ φ {Inl x}"
    by blast+
  have fsafe:"fsafe (Exists x φ) ⟹ fsafe φ"
    by (auto dest: fsafe.cases)
  have eq:"fsafe (Exists x φ) ⟹ (⋀i. dsafe (σ i)) ⟹ (⋀ν. (ν ∈ fml_sem I (FsubstFO (Exists x φ) σ)) = (ν ∈ fml_sem (adjointFO I σ ν)  (Exists x φ)))"
  proof -
    assume fsafe:"fsafe (Exists x φ)"
    from fsafe have fsafe':"fsafe φ" by (auto dest: fsafe.cases)
    assume ssafe:"(⋀i. dsafe (σ i))"
    fix ν
    have agree:"⋀r. Vagree ν (repv ν x r) (- {Inl x})"
      unfolding Vagree_def by auto
    have sem_eq:"⋀r. ((repv ν x r) ∈ fml_sem (adjointFO I σ (repv ν x r)) φ) =
                      ((repv ν x r) ∈ fml_sem (adjointFO I σ ν) φ)"
      using uadmit_fml_ntadjoint[OF FUA agree ssafe fsafe' good_interp] by auto
    have "(ν ∈ fml_sem I (FsubstFO  (Exists x φ) σ)) = (∃r. (repv ν x r) ∈ fml_sem I (FsubstFO φ σ))"
      by auto
    moreover have "... = (∃r. (repv ν x r) ∈ fml_sem (adjointFO I σ (repv ν x r)) φ)"
      using IH[OF fsafe' ssafe] by auto
    moreover have "... = (∃r. (repv ν x r) ∈ fml_sem (adjointFO I σ ν) φ)"
      using sem_eq by auto
    moreover have "... = (ν ∈ fml_sem (adjointFO I σ ν) (Exists x φ))"
      by auto
    ultimately show "(ν ∈ fml_sem I (FsubstFO  (Exists x φ) σ)) = (ν ∈ fml_sem (adjointFO I σ ν) (Exists x φ))"
      by auto
  qed
  then show ?case by auto
next
  case (NFadmit_Diamond σ φ a) then 
  have PA:"NPadmit σ a" 
    and FUA:"FUadmitFO σ φ (BVP (PsubstFO a σ))"
    and IH1:"fsafe φ ⟹ (⋀i. dsafe (σ i)) ⟹ (⋀ν. (ν ∈ fml_sem I (FsubstFO φ σ)) = (ν ∈ fml_sem (adjointFO I σ ν) φ))"
    and IH2:"hpsafe a ⟹ (⋀i. dsafe (σ i)) ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (PsubstFO a σ)) = ((ν, ω) ∈ prog_sem (adjointFO I σ ν) a))"
    and hpsafeF:"hpsafe (PsubstFO a σ)"
      by auto
  have "fsafe (⟨ a ⟩ φ) ⟹ (⋀i. dsafe (σ i)) ⟹ (⋀ν. (ν ∈ fml_sem I (FsubstFO (⟨ a ⟩ φ) σ)) = (ν ∈ fml_sem (adjointFO I σ ν) (⟨ a ⟩ φ)))"
  proof -
    assume fsafe:"fsafe (⟨ a ⟩ φ)"
    assume ssafe:"(⋀i. dsafe (σ i))"
    from fsafe have fsafe':"fsafe φ" and hpsafe:"hpsafe a" by (auto dest: fsafe.cases)
    fix ν
    have agree:"⋀ω. (ν, ω) ∈ prog_sem I (PsubstFO a σ) ⟹ Vagree ν ω (-BVP(PsubstFO a σ))"
      using bound_effect[OF good_interp, of "(PsubstFO a σ)" ν, OF hpsafeF] by auto
    have sem_eq:"⋀ω. (ν, ω) ∈ prog_sem I (PsubstFO a σ) ⟹ 
        (ω ∈ fml_sem (adjointFO I σ ν) φ) =
        (ω ∈ fml_sem (adjointFO I σ ω) φ)"
      using uadmit_fml_ntadjoint [OF FUA agree ssafe fsafe' good_interp] by auto
    have "(ν ∈ fml_sem I (FsubstFO (⟨ a ⟩ φ) σ)) = (∃ ω. (ν, ω) ∈ prog_sem I (PsubstFO a σ) ∧ ω ∈ fml_sem I (FsubstFO φ σ))"
      by auto
    moreover have "... = (∃ ω. (ν, ω) ∈ prog_sem (adjointFO I σ ν) a ∧ ω ∈ fml_sem (adjointFO I σ ω) φ)"
      using IH1[OF fsafe' ssafe] IH2[OF hpsafe ssafe, of ν] by auto
    moreover have "... = (∃ ω. (ν, ω) ∈ prog_sem (adjointFO I σ ν) a ∧ ω ∈ fml_sem (adjointFO I σ ν) φ)"
      using sem_eq IH2 hpsafe ssafe by blast
    moreover have "... = (ν ∈ fml_sem (adjointFO I σ ν) (⟨ a ⟩ φ))"
      by auto
    ultimately show "?thesis ν" by auto
  qed
  then show ?case by auto
next
  case (NFadmit_Context σ φ C) then
  have FA:"NFadmit σ φ"
    and FUA:"FUadmitFO σ φ UNIV"
    and IH:"fsafe φ ⟹ (⋀i. dsafe (σ i)) ⟹ (⋀ν. (ν ∈ fml_sem I (FsubstFO φ σ)) = (ν ∈ fml_sem (adjointFO I σ ν) φ))"
      by auto
  have "fsafe (InContext C φ) ⟹
           (⋀i. dsafe (σ i))⟹ (⋀ν. (ν ∈ fml_sem I (FsubstFO (InContext C φ) σ)) = (ν ∈ fml_sem (adjointFO I σ ν) (InContext C φ)))"
  proof -
    assume safe:"fsafe (InContext C φ)"
    then have fsafe:"fsafe φ" by (auto dest: fsafe.cases)
    assume ssafe:"⋀i. dsafe (σ i)"
    fix ν
    have Ieq:" Contexts (adjointFO I σ ν) C = Contexts I C"
      unfolding adjointFO_def by auto
    have IH':"⋀ν. (ν ∈ fml_sem I (FsubstFO φ σ)) = (ν ∈ fml_sem (adjointFO I σ ν) φ)"
      using IH[OF fsafe ssafe] by auto
    have agree:"⋀ω. Vagree ν ω (-UNIV)" unfolding Vagree_def by auto
    have adj_eq:"⋀ω. fml_sem (adjointFO I σ ν) φ = fml_sem (adjointFO I σ ω) φ"
      using uadmit_fml_ntadjoint[OF FUA agree ssafe fsafe good_interp] by auto
    then have sem:"fml_sem I (FsubstFO φ σ) =  fml_sem (adjointFO I σ ν) φ"
      using IH' agree adj_eq by auto
    show "?thesis ν"  using Ieq sem by auto
  qed
  then show ?case by auto
qed (auto)

lemma nsubst_fml:
  fixes I::"('sf, 'sc, 'sz) interp"
  fixes ν::"'sz state"
  assumes good_interp:"is_interp I"
  assumes NFA:"NFadmit σ φ"
  assumes fsafe:"fsafe φ"
  assumes frees:"(∀i. dsafe (σ i))"
  shows "(ν ∈ fml_sem I (FsubstFO φ σ)) = (ν ∈ fml_sem (adjointFO I σ ν) φ)"
  using good_interp NFA fsafe frees 
  by (auto simp add: nsubst_hp_fml)

lemma nsubst_hp:
  fixes I::"('sf, 'sc, 'sz) interp"
  fixes ν::"'sz state"
  assumes good_interp:"is_interp I"    
  assumes NPA:"NPadmit σ α"
  assumes hpsafe:"hpsafe α"
  assumes frees:"⋀i. dsafe (σ i)"
  shows "((ν, ω) ∈ prog_sem I (PsubstFO α σ)) = ((ν, ω) ∈  prog_sem (adjointFO I σ ν) α)"
 using good_interp NPA hpsafe frees nsubst_hp_fml by blast

lemma psubst_sterm:
  fixes I::"('sf, 'sc, 'sz) interp"
  assumes good_interp:"is_interp I"    
  shows "(sterm_sem I θ = sterm_sem (PFadjoint I σ) θ)"
proof (induction θ)
qed (auto simp add: PFadjoint_def)

lemma psubst_dterm:
  fixes I::"('sf, 'sc, 'sz) interp"
  assumes good_interp:"is_interp I"    
  shows "(dsafe θ ⟹ dterm_sem I θ = dterm_sem (PFadjoint I σ) θ)"
proof (induction θ)
  case (Differential θ)
  assume safe:"dsafe (Differential θ)"
  from safe have free:"dfree θ" by auto
  assume sem:"dsafe θ ⟹ dterm_sem I θ = dterm_sem (PFadjoint I σ) θ"
  have "⋀ν. frechet I θ (fst ν) (snd ν) = frechet (PFadjoint I σ) θ (fst ν) (snd ν)"
    apply(rule sterm_determines_frechet)
        using good_interp free apply auto
     subgoal unfolding is_interp_def PFadjoint_def by auto
    using psubst_sterm[of I θ] by auto
  then show "?case"
    by (auto simp add: directional_derivative_def)
 qed (auto simp add: PFadjoint_def)
    
lemma psubst_ode:
assumes good_interp:"is_interp I"
shows "ODE_sem I ODE = ODE_sem (PFadjoint I σ) ODE"
proof (induction "ODE")
  case (OVar x)
  then show ?case unfolding PFadjoint_def by auto
next
  case (OSing x1a x2)
  then show ?case apply auto apply (rule ext) apply (rule vec_extensionality) using psubst_sterm[OF good_interp, of x2 σ]  by auto 
next
  case (OProd ODE1 ODE2)
  then show ?case by auto
qed
  
lemma psubst_fml:
fixes I::"('sf, 'sc, 'sz) interp"
assumes good_interp:"is_interp I"    
shows "(PPadmit σ α  ⟶ hpsafe α ⟶ (∀i. fsafe (σ i)) ⟶ (∀ ν ω. (ν,ω) ∈ prog_sem I (PPsubst α σ) = ((ν,ω) ∈ prog_sem (PFadjoint I σ) α))) ∧ 
  (PFadmit σ φ ⟶ fsafe φ ⟶ (∀i. fsafe (σ i)) ⟶ (∀ ν. ν ∈ fml_sem I (PFsubst φ σ) = (ν ∈ fml_sem (PFadjoint I σ) φ)))"
proof (induction rule: PPadmit_PFadmit.induct)
  case (PPadmit_ODE σ φ ODE)
  assume PF:"PFadmit σ φ"
  assume PFU:"PFUadmit σ φ (BVO ODE)"
  assume IH:"fsafe φ ⟶ (∀i. fsafe (σ i)) ⟶ (∀ν. (ν ∈ fml_sem I (PFsubst φ σ)) = (ν ∈ fml_sem (PFadjoint I σ) φ))"
  have "hpsafe (EvolveODE ODE φ) ⟹
  (∀i. fsafe (σ i)) ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (PPsubst (EvolveODE ODE φ) σ)) = ((ν, ω) ∈ prog_sem (PFadjoint I σ) (EvolveODE ODE φ)))"
  proof -
    assume safe:"hpsafe (EvolveODE ODE φ)"
    from safe have fsafe:"fsafe φ" by auto
    assume ssafe:"(∀i. fsafe (σ i))"
    have fml_eq:"⋀ν. (ν ∈ fml_sem I (PFsubst φ σ)) = (ν ∈ fml_sem (PFadjoint I σ) φ)"
      using IH ssafe fsafe by auto
    fix ν ω
    show "((ν, ω) ∈ prog_sem I (PPsubst (EvolveODE ODE φ) σ)) = ((ν, ω) ∈ prog_sem (PFadjoint I σ) (EvolveODE ODE φ))"
      apply auto
    proof -
      fix b sol t
      assume eq1:"ν = (sol 0, b)"
        and eq2:"ω = mk_v I ODE (sol 0, b) (sol t)"
        and t:"0 ≤ t"
        and sol:"(sol solves_ode (λa. ODE_sem I ODE)) {0..t} {x. mk_v I ODE (sol 0, b) x ∈ fml_sem I (PFsubst φ σ)}"
      have var:"ODE_vars I ODE =  ODE_vars (PFadjoint I σ) ODE"
        by(induction ODE, auto simp add: PFadjoint_def)
      have mkv_eq:"⋀s. s ∈ {0..t} ⟹ mk_v I ODE (sol 0, b) (sol s) = mk_v (PFadjoint I σ) ODE (sol 0, b) (sol s)"
        apply(rule agree_UNIV_eq)
        unfolding Vagree_def apply auto
         subgoal for s i
           using mk_v_agree[of I ODE "(sol 0, b)" "sol s"] mk_v_agree[of "PFadjoint I σ" ODE "(sol 0, b)" "sol s"]
           unfolding Vagree_def var 
           apply (cases "Inl i ∈ Inl ` ODE_vars I ODE", auto simp add: var)
            by force
        subgoal for s i
          using mk_v_agree[of I ODE "(sol 0, b)" "sol s"] mk_v_agree[of "PFadjoint I σ" ODE "(sol 0, b)" "sol s"]
          unfolding Vagree_def var 
          apply (cases "Inr i ∈ Inr ` ODE_vars I ODE", auto simp add: var psubst_ode)
           using psubst_ode[OF good_interp, of ODE σ] apply auto
          using psubst_ode[OF good_interp, of ODE σ] by force
        done
      have sol':"(sol solves_ode (λ_. ODE_sem (PFadjoint I σ) ODE)) {0..t}
       {x. mk_v I ODE (sol 0, b) x ∈ fml_sem I (PFsubst φ σ)}"
        apply (rule solves_ode_congI)
            apply (rule sol)
           subgoal for ta by auto
          subgoal for ta using psubst_ode[OF good_interp, of ODE σ] by auto
         subgoal by (rule refl)
        subgoal by (rule refl)
        done
      have sub:"⋀s. s ∈ {0..t} 
              ⟹ sol s ∈ {x. (mk_v (PFadjoint I σ ) ODE (sol 0, b) x ∈ fml_sem (PFadjoint I σ ) φ)}"
        subgoal for s
          using solves_ode_domainD[OF sol, of s] mkv_eq[of s] fml_eq[of "mk_v (PFadjoint I σ ) ODE (sol 0, b) (sol s)"]
          by auto
        done
      have sol'':"(sol solves_ode (λc. ODE_sem (PFadjoint I σ ) ODE)) {0..t}
        {x. mk_v (PFadjoint I σ) ODE (sol 0, b) x ∈ fml_sem (PFadjoint I σ ) φ}"
        apply (rule solves_odeI)
         subgoal using sol' solves_ode_vderivD by blast
        using sub by auto          
      show"∃sola. sol 0 = sola 0 ∧
          (∃ta. mk_v I ODE (sol 0, b) (sol t) = mk_v (PFadjoint I σ) ODE (sola 0, b) (sola ta) ∧
                0 ≤ ta ∧
                (sola solves_ode (λa. ODE_sem (PFadjoint I σ) ODE)) {0..ta}
               {x. mk_v (PFadjoint I σ) ODE (sola 0, b) x ∈ fml_sem (PFadjoint I σ) φ})"
        apply(rule exI[where x=sol])
        apply(rule conjI)
         apply(rule refl)
        apply(rule exI[where x=t])
        apply(rule conjI)
         subgoal using mkv_eq t by auto
        apply(rule conjI)
         apply(rule t)
        apply(rule sol'') 
        done
    next
      fix b sol t
      assume eq1:"ν = (sol 0, b)"
        and eq2:"ω = mk_v (PFadjoint I σ) ODE (sol 0, b) (sol t)"
        and t:"0 ≤ t"
        and sol:"(sol solves_ode (λa. ODE_sem (PFadjoint I σ) ODE)) {0..t} {x. mk_v (PFadjoint I σ) ODE (sol 0, b) x ∈ fml_sem (PFadjoint I σ) φ}"
      have var:"ODE_vars I ODE =  ODE_vars (PFadjoint I σ) ODE"
        by(induction ODE, auto simp add: PFadjoint_def)
      have mkv_eq:"⋀s. s ∈ {0..t} ⟹ mk_v I ODE (sol 0, b) (sol s) = mk_v (PFadjoint I σ) ODE (sol 0, b) (sol s)"
        apply(rule agree_UNIV_eq)
        unfolding Vagree_def apply auto
         subgoal for s i
           using mk_v_agree[of I ODE "(sol 0, b)" "sol s"] mk_v_agree[of "PFadjoint I σ" ODE "(sol 0, b)" "sol s"]
           unfolding Vagree_def var 
           apply (cases "Inl i ∈ Inl ` ODE_vars I ODE", auto simp add: var)
            by force
        subgoal for s i
          using mk_v_agree[of I ODE "(sol 0, b)" "sol s"] mk_v_agree[of "PFadjoint I σ" ODE "(sol 0, b)" "sol s"]
          unfolding Vagree_def var 
          apply (cases "Inr i ∈ Inr ` ODE_vars I ODE", auto simp add: var psubst_ode)
           using psubst_ode[OF good_interp, of ODE σ] apply auto
          using psubst_ode[OF good_interp, of ODE σ] by force
        done
      have sol':"(sol solves_ode (λ_. ODE_sem I ODE)) {0..t}
         {x. mk_v (PFadjoint I σ) ODE (sol 0, b) x ∈ fml_sem (PFadjoint I σ) φ}"
        apply (rule solves_ode_congI)
            apply (rule sol)
           subgoal for ta by auto
          subgoal for ta using psubst_ode[OF good_interp, of ODE σ] by auto
         subgoal by (rule refl)
        subgoal by (rule refl)
        done
      have sub:"⋀s. s ∈ {0..t} 
              ⟹ sol s ∈ {x. (mk_v  I ODE (sol 0, b) x ∈ fml_sem I (PFsubst φ σ))}"
        subgoal for s
          using solves_ode_domainD[OF sol, of s] mkv_eq[of s] fml_eq[of "mk_v (PFadjoint I σ ) ODE (sol 0, b) (sol s)"]
          by auto
        done
      have sol'':"(sol solves_ode (λc. ODE_sem I ODE)) {0..t}
        {x. mk_v I ODE (sol 0, b) x ∈ fml_sem I (PFsubst φ σ)}"
        apply (rule solves_odeI)
         subgoal using sol' solves_ode_vderivD by blast
        using sub by auto
      show "∃sola. sol 0 = sola 0 ∧
          (∃ta. mk_v (PFadjoint I σ) ODE (sol 0, b) (sol t) = mk_v I ODE (sola 0, b) (sola ta) ∧
                0 ≤ ta ∧ (sola solves_ode (λa. ODE_sem I ODE)) {0..ta} {x. mk_v I ODE (sola 0, b) x ∈ fml_sem I (PFsubst φ σ)})"
        apply(rule exI[where x=sol])
        by (metis dual_order.refl intervalE mkv_eq sol'' t)
    qed
  qed
  then show ?case
    by auto
next
  case (PPadmit_Assign σ x θ)
  have "hpsafe (x := θ) ⟹ (∀i. fsafe (σ i)) ⟹ (∀ ν ω. ((ν, ω) ∈ prog_sem I (PPsubst (x := θ) σ)) = ((ν, ω) ∈ prog_sem (PFadjoint I σ) (x := θ)))"
  proof -
    assume safe:"hpsafe (x := θ)"
    then have dsafe:"dsafe θ" by auto
    assume safes:"(∀i. fsafe (σ i))"
    show "?thesis"
      using psubst_dterm[OF good_interp dsafe, of σ] by auto
  qed
  then show "?case" by auto 
next
  case (PPadmit_DiffAssign σ x θ)
  have "hpsafe (DiffAssign x θ) ⟹ (∀i. fsafe (σ i)) ⟹ (∀ ν ω. ((ν, ω) ∈ prog_sem I (PPsubst (DiffAssign x θ) σ)) = (((ν, ω) ∈ prog_sem (PFadjoint I σ) (DiffAssign x θ))))"
  proof -
    assume safe:"hpsafe (DiffAssign x θ)"
    then have dsafe:"dsafe θ" by auto
    assume safes:"(∀i. fsafe (σ i))"
    show "?thesis"
      using psubst_dterm[OF good_interp dsafe, of σ] by auto
   qed
  then show ?case by auto
next
  case (PFadmit_Geq σ θ1 θ2) then 
  have "fsafe (Geq θ1 θ2) ⟹ (∀i. fsafe (σ i)) ⟹ (∀ ν. (ν ∈ fml_sem I (PFsubst (Geq θ1 θ2) σ)) = (ν ∈ fml_sem (PFadjoint I σ) (Geq θ1 θ2)))"
  proof -
    assume safe:"fsafe (Geq θ1 θ2)"
    then have safe1:"dsafe θ1" 
      and safe2:"dsafe θ2" by auto
    assume safes:"(∀i. fsafe (σ i))"
    show "?thesis"
      using psubst_dterm[OF good_interp safe1, of σ] psubst_dterm[OF good_interp safe2, of σ] by  auto
  qed
  then show ?case by auto
next
  case (PFadmit_Prop σ p args) then
  have "fsafe (Prop p args) ⟹ (⋀i. fsafe (σ i)) ⟹ (⋀ν.(ν ∈ fml_sem I (PFsubst ($φ p args) σ)) = (ν ∈ fml_sem (PFadjoint I σ) ($φ p args)))"
  proof -
    assume safe:"fsafe (Prop p args)" and ssafe:" (⋀i. fsafe (σ i))"
    fix ν
    from safe have safes:"⋀i. dsafe (args i)" using dfree_is_dsafe by auto
    have Ieq:"Predicates I p = Predicates (PFadjoint I σ) p"
      unfolding PFadjoint_def by auto
    have vec:"(χ i. dterm_sem I (args i) ν) = (χ i. dterm_sem (PFadjoint I σ) (args i) ν)"
      apply(auto simp add: vec_eq_iff)
      subgoal for i using safes[of i] 
        by (metis good_interp psubst_dterm)
      done
    show "?thesis ν" using  Ieq vec by auto
  qed
  then show "?case" by auto
next
  case (PPadmit_Sequence σ a b) then 
  have PUA:"PPUadmit σ b (BVP (PPsubst a σ))"
    and PA:"PPadmit σ a"
    and IH1:"hpsafe a ⟹ (⋀i. fsafe (σ i)) ⟹ (∀ ν ω. ((ν, ω) ∈ prog_sem I (PPsubst a σ)) = ((ν, ω) ∈ prog_sem (PFadjoint I σ) a))"
    and IH2:"hpsafe b ⟹ (⋀i. fsafe (σ i)) ⟹ (∀ ν ω. ((ν, ω) ∈ prog_sem I (PPsubst b σ)) = ((ν, ω) ∈ prog_sem (PFadjoint I σ) b))"
    and substSafe:"hpsafe (PPsubst a σ)"
    by auto
  have "hpsafe (a ;; b) ⟹ (⋀i. fsafe (σ i)) ⟹ (⋀ ν ω. ((ν, ω) ∈ prog_sem I (PPsubst (a ;; b) σ)) = ((ν, ω) ∈ prog_sem (PFadjoint I σ) (a ;; b)))"
  proof -
    assume hpsafe:"hpsafe (a ;; b)"
    assume ssafe:"(⋀i. fsafe (σ i))"
    from hpsafe have safe1:"hpsafe a" and safe2:"hpsafe b" by (auto dest: hpsafe.cases)
    fix ν ω
    have agree:"⋀μ. (ν, μ) ∈ prog_sem I (PPsubst a σ) ⟹ Vagree ν μ (-BVP(PPsubst a σ))"
      subgoal for μ
        using bound_effect[OF good_interp, of "(PPsubst a σ)" ν, OF substSafe] by auto
      done
    have sem_eq:"⋀μ. (ν, μ) ∈ prog_sem I (PPsubst a σ) ⟹ 
        ((μ, ω) ∈ prog_sem (PFadjoint I σ) b) =
        ((μ, ω) ∈ prog_sem (PFadjoint I σ) b)"
      subgoal for μ
      proof -
        assume assm:"(ν, μ) ∈ prog_sem I (PPsubst a σ)"
        show "((μ, ω) ∈ prog_sem (PFadjoint I σ) b) = ((μ, ω) ∈ prog_sem (PFadjoint I σ) b)"
          using PUA agree[OF assm] safe2 ssafe good_interp by auto
      qed
      done      
    have "((ν, ω) ∈ prog_sem I (PPsubst (a ;; b) σ)) = (∃ μ. (ν, μ) ∈ prog_sem I (PPsubst a σ) ∧ (μ, ω) ∈ prog_sem I (PPsubst b σ))"
      by auto
    moreover have "... = (∃ μ. (ν, μ) ∈ prog_sem I (PPsubst a σ) ∧ (μ, ω) ∈ prog_sem (PFadjoint I σ) b)"
      using IH2[OF safe2 ssafe] by blast 
    moreover have "... = (∃ μ. (ν, μ) ∈ prog_sem (PFadjoint I σ) a ∧ (μ, ω) ∈ prog_sem (PFadjoint I σ) b)"
      using IH1[OF safe1 ssafe] sem_eq by blast
    ultimately
    show "((ν, ω) ∈ prog_sem I (PPsubst (a ;; b) σ)) = ((ν, ω) ∈ prog_sem (PFadjoint I σ) (a ;; b))"
      by auto
  qed
  then show ?case by auto
next
  case (PPadmit_Loop σ a) then 
  have PA:"PPadmit σ a"
  and PUA:"PPUadmit σ a (BVP (PPsubst a σ))"
  and IH:"hpsafe a ⟹ (⋀i. fsafe (σ i)) ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (PPsubst a σ)) = ((ν, ω) ∈ prog_sem (PFadjoint I σ) a))"
  and substSafe:"hpsafe (PPsubst a σ)"   
    by auto
  have "hpsafe (a**) ⟹ (⋀i. fsafe (σ i)) ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (PPsubst (a**) σ)) = ((ν, ω) ∈ prog_sem (PFadjoint I σ) (a**)))"
  proof -
    assume "hpsafe (a**)"
    then have hpsafe:"hpsafe a" by (auto dest: hpsafe.cases)
    assume ssafe:"⋀i. fsafe (σ i)"
    have agree:"⋀ν μ. (ν, μ) ∈ prog_sem I (PPsubst a σ) ⟹ Vagree ν μ (-BVP(PPsubst a σ))"
      subgoal for ν μ
        using bound_effect[OF good_interp, of "(PPsubst a σ)" ν, OF substSafe] by auto
      done
    fix ν ω
    have UN_rule:"⋀ a S S'. (⋀n b. (a,b) ∈ S n ⟷ (a,b) ∈ S' n) ⟹ (⋀b. (a,b) ∈ (⋃n. S n) ⟷ (a,b) ∈ (⋃n. S' n))"
      by auto
    have eqL:"((ν, ω) ∈ prog_sem I (PPsubst (a**) σ)) = ((ν, ω) ∈ (⋃n. (prog_sem I (PPsubst a σ)) ^^ n))"
      using rtrancl_is_UN_relpow by auto
    moreover have eachEq:"⋀n. ((⋀ν ω. ((ν, ω) ∈ (prog_sem I (PPsubst a σ)) ^^ n) = ((ν, ω) ∈ (prog_sem (PFadjoint I σ) a)^^ n)))"
    proof -
      fix n
      show "((⋀ν ω. ((ν, ω) ∈ (prog_sem I (PPsubst a σ)) ^^ n) = ((ν, ω) ∈ (prog_sem (PFadjoint I σ) a)^^ n)))"
      proof (induct n)
        case 0
        then show ?case by auto
      next
        case (Suc n) then
        have IH2:"⋀ν ω. ((ν, ω) ∈ prog_sem I (PPsubst a σ) ^^ n) = ((ν, ω) ∈ prog_sem (PFadjoint I σ) a ^^ n)"
          by auto
        have relpow:"⋀R n. R ^^ Suc n = R O R ^^ n"
          using relpow.simps(2) relpow_commute by metis
        show ?case 
          apply (simp only: relpow[of n "prog_sem I (PPsubst a σ)"] relpow[of n "prog_sem (PFadjoint I σ) a"])
          apply(unfold relcomp_unfold)
          apply auto
           subgoal for ab b
              apply(rule exI[where x=ab])
              apply(rule exI[where x=b])
              using IH2 IH[OF hpsafe ssafe]  by auto
          subgoal for ab b
            apply(rule exI[where x=ab])
            apply(rule exI[where x=b])
            using IH2 IH[OF hpsafe ssafe] by auto
        done
      qed
    qed
    moreover have "((ν, ω) ∈ (⋃n. (prog_sem I (PPsubst a σ)) ^^ n)) = ((ν, ω) ∈ (⋃ n.(prog_sem (PFadjoint I σ) a)^^ n))"
      apply(rule UN_rule)
      using eachEq by auto
    moreover have eqR:"((ν, ω) ∈ prog_sem (PFadjoint I σ) (a**)) = ((ν, ω) ∈ (⋃n. (prog_sem (PFadjoint I σ) a) ^^ n))"
       using rtrancl_is_UN_relpow by auto
    ultimately show "((ν, ω) ∈ prog_sem I (PPsubst (a**) σ)) = ((ν, ω) ∈ prog_sem (PFadjoint I σ) (a**))"
      by auto
  qed
  then show ?case by auto
next
next
  case (PFadmit_Context σ φ C) then
  have FA:"PFadmit σ φ"
    and FUA:"PFUadmit σ φ UNIV"
    and IH:"fsafe φ ⟹ (⋀i. fsafe (σ i)) ⟹ (⋀ν. (ν ∈ fml_sem I (PFsubst φ σ)) = (ν ∈ fml_sem (PFadjoint I σ) φ))"
    by auto
  have "fsafe (InContext C φ) ⟹
           (⋀i. fsafe (σ i)) ⟹ (⋀ν. (ν ∈ fml_sem I (PFsubst (InContext C φ) σ)) = (ν ∈ fml_sem (PFadjoint I σ) (InContext C φ)))"
  proof -
    assume safe:"fsafe (InContext C φ)"
    then have fsafe:"fsafe φ" by (auto dest: fsafe.cases)
    assume ssafe:"(⋀i. fsafe (σ i))"
    fix ν :: "(real, 'sz) vec × (real, 'sz) vec"
    have IH':"⋀ν. (ν ∈ fml_sem I (PFsubst φ σ)) = (ν ∈ fml_sem (PFadjoint I σ) φ)"
      using IH[OF fsafe ssafe] by auto
    have agree:"⋀ω. Vagree ν ω (-UNIV)" unfolding Vagree_def by auto
    then have sem:"fml_sem I (PFsubst φ σ) =  fml_sem (PFadjoint I σ) φ"
      using IH' agree  by auto
    show "?thesis ν"  using sem 
      apply auto
      apply(cases C)
        unfolding PFadjoint_def apply auto
      apply(cases C)
       by auto
  qed
  then show ?case by auto
qed (auto simp add: PFadjoint_def)

lemma subst_ode:
  fixes I:: "('sf, 'sc, 'sz) interp" and ν :: "'sz state"
  assumes good_interp:"is_interp I"
  shows "osafe ODE ⟹ 
         ssafe σ ⟹ 
         Oadmit σ ODE (BVO ODE) ⟹
         ODE_sem I (Osubst ODE σ) (fst ν) = ODE_sem (adjoint I σ ν) ODE (fst ν)"
proof (induction rule: osafe.induct)
  case (osafe_Var c)
  then show ?case unfolding adjoint_def by (cases "SODEs σ c", auto)
next
  case (osafe_Sing θ x)
  then show ?case 
    using subst_sterm [of  σ θ I "ν"]
    unfolding ssafe_def by auto
next
  case (osafe_Prod ODE1 ODE2) then
  have NOU1:"Oadmit σ ODE1  (BVO (OProd ODE1 ODE2))" and NOU2:"Oadmit σ ODE2  (BVO (OProd ODE1 ODE2))" 
    by auto
  have TUA_sub:"⋀σ θ A B. TUadmit σ θ B ⟹ A ⊆ B ⟹ TUadmit σ θ A"
    unfolding TUadmit_def by auto
  have OA_sub:"⋀ODE A B. Oadmit σ ODE B ⟹ A ⊆ B ⟹ Oadmit σ ODE A"
    subgoal for ODE A B
    proof (induction rule: Oadmit.induct)
      case (Oadmit_Var σ c U)
      then show ?case by auto
    next
      case (Oadmit_Sing σ θ U x)
      then show ?case using TUA_sub[of σ θ U A] by auto
    next
      case (Oadmit_Prod σ ODE1 U ODE2)
      then show ?case by auto
    qed
    done
  have sub1:"(BVO ODE1) ⊆ (BVO (OProd ODE1 ODE2))"
    by auto
  have sub2: "(BVO ODE2) ⊆ (BVO (OProd ODE1 ODE2))"
    by auto
  have "ODE_sem I (Osubst ODE1 σ) (fst ν) = ODE_sem (adjoint I σ ν) ODE1 (fst ν)"
    "ODE_sem I (Osubst ODE2 σ) (fst ν) = ODE_sem (adjoint I σ ν) ODE2 (fst ν)" using osafe_Prod.IH osafe_Prod.prems osafe_Prod.hyps
    using OA_sub[OF NOU1 sub1] OA_sub[OF NOU2 sub2] by auto
  then show ?case by auto
qed

lemma osubst_eq_ODE_vars: "ODE_vars I (Osubst ODE σ) = ODE_vars (adjoint I σ ν) ODE"
proof (induction ODE)
  case (OVar x)
  then show ?case by (cases "SODEs σ x", auto simp add: adjoint_def)
qed (auto)

lemma subst_semBV:"semBV (adjoint I σ ν') ODE = (semBV I (Osubst ODE σ))"
proof (induction ODE)
  case (OVar x)
  then show ?case by (cases "SODEs σ x", auto simp add: adjoint_def)
qed (auto)

lemma subst_mkv:
  fixes I::"('sf, 'sc, 'sz) interp"
  fixes ν::"'sz state"
  fixes ν'::"'sz state"
  assumes good_interp:"is_interp I"  
  assumes NOU:"Oadmit σ ODE (BVO ODE)"
  assumes osafe:"osafe ODE "
  assumes frees:"ssafe σ"
  shows "(mk_v I (Osubst ODE σ) ν (fst ν')) 
    = (mk_v (adjoint I σ ν') ODE ν (fst ν'))"
  apply(rule agree_UNIV_eq)
  using mk_v_agree[of "adjoint I σ ν'" "ODE" ν "fst ν'"]
  using mk_v_agree[of "I" "Osubst ODE σ" ν "fst ν'"] 
  unfolding Vagree_def 
  using subst_ode[OF good_interp osafe  frees NOU, of ν'] 
  apply auto
   subgoal for i
     apply(erule allE[where x=i])+
     apply(cases "Inl i ∈ Inl ` ODE_vars (adjoint I σ ν') ODE")
      using osubst_eq_ODE_vars[of I ODE σ ν']
      apply force
   proof -
     assume "ODE_sem I (Osubst ODE σ) (fst ν') = ODE_sem (local.adjoint I σ ν') ODE (fst ν')"
       "Inl i ∉ Inl ` ODE_vars (local.adjoint I σ ν') ODE ∧ Inl i ∉ Inr ` ODE_vars (local.adjoint I σ ν') ODE ⟶
       fst (mk_v (local.adjoint I σ ν') ODE ν (fst ν')) $ i = fst ν $ i"
       "Inl i ∉ Inl ` ODE_vars I (Osubst ODE σ) ∧ Inl i ∉ Inr ` ODE_vars I (Osubst ODE σ) ⟶
       fst (mk_v I (Osubst ODE σ) ν (fst ν')) $ i = fst ν $ i"
       "Inl i ∉ Inl ` ODE_vars (local.adjoint I σ ν') ODE"
     then show
        "fst (mk_v I (Osubst ODE σ) ν (fst ν')) $ i = fst (mk_v (local.adjoint I σ ν') ODE ν (fst ν')) $ i"
         using osubst_eq_ODE_vars[of I ODE σ ν'] by force
   qed
  subgoal for i
    apply(erule allE[where x=i])+
    apply(cases "Inr i ∈ Inr ` ODE_vars (adjoint I σ ν') ODE")
     using osubst_eq_ODE_vars[of I ODE σ ν']
     apply force
  proof -
    assume "ODE_sem I (Osubst ODE σ) (fst ν') = ODE_sem (local.adjoint I σ ν') ODE (fst ν')"
      "Inr i ∉ Inl ` ODE_vars (local.adjoint I σ ν') ODE ∧ Inr i ∉ Inr ` ODE_vars (local.adjoint I σ ν') ODE ⟶
      snd (mk_v (local.adjoint I σ ν') ODE ν (fst ν')) $ i = snd ν $ i"
      "Inr i ∉ Inl ` ODE_vars I (Osubst ODE σ) ∧ Inr i ∉ Inr ` ODE_vars I (Osubst ODE σ) ⟶
      snd (mk_v I (Osubst ODE σ) ν (fst ν')) $ i = snd ν $ i"
      "Inr i ∉ Inr ` ODE_vars (local.adjoint I σ ν') ODE"
    then show "snd (mk_v I (Osubst ODE σ) ν (fst ν')) $ i = snd (mk_v (local.adjoint I σ ν') ODE ν (fst ν')) $ i"
      using osubst_eq_ODE_vars[of I ODE σ ν'] by force
  qed
done 
  
lemma subst_fml_hp:
  fixes I::"('sf, 'sc, 'sz) interp"
  assumes good_interp:"is_interp I"
  shows 
  "(Padmit σ α ⟶
    (hpsafe α ⟶
     ssafe σ ⟶
    (∀ ν ω. ((ν, ω) ∈ prog_sem I (Psubst α σ)) = ((ν, ω) ∈ prog_sem (adjoint I σ ν) α))))
    ∧
    (Fadmit σ φ ⟶
    (fsafe φ ⟶
    ssafe σ ⟶
    (∀ ν. (ν ∈ fml_sem I (Fsubst φ σ)) = (ν ∈ fml_sem (adjoint I σ ν) φ))))"
proof (induction rule: Padmit_Fadmit.induct)
  case (Padmit_Pvar σ a) then
  have "hpsafe ($α a) ⟹ ssafe σ ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (Psubst ($α a) σ)) = ((ν, ω) ∈ prog_sem (local.adjoint I σ ν) ($α a)))"
    apply (cases "SPrograms σ a")
     unfolding adjoint_def by auto
  then show ?case by auto
next
  case (Padmit_Sequence σ a b) then 
  have PUA:"PUadmit σ b (BVP (Psubst a σ))"
    and PA:"Padmit σ a"
    and IH1:"hpsafe a ⟹ ssafe σ ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (Psubst a σ)) = ((ν, ω) ∈ prog_sem (local.adjoint I σ ν) a))"
    and IH2:"hpsafe b ⟹ ssafe σ ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (Psubst b σ)) = ((ν, ω) ∈ prog_sem (local.adjoint I σ ν) b))"
    and substSafe:"hpsafe (Psubst a σ)"
    by auto
  have "hpsafe (a ;; b) ⟹ ssafe σ ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (Psubst (a ;; b) σ)) = ((ν, ω) ∈ prog_sem (local.adjoint I σ ν) (a ;; b)))"
  proof -
    assume hpsafe:"hpsafe (a ;; b)"
    assume ssafe:"ssafe σ"
    from hpsafe have safe1:"hpsafe a" and safe2:"hpsafe b" by (auto dest: hpsafe.cases)
    fix ν ω
    have agree:"⋀μ. (ν, μ) ∈ prog_sem I (Psubst a σ) ⟹ Vagree ν μ (-BVP(Psubst a σ))"
      subgoal for μ
        using bound_effect[OF good_interp, of "(Psubst a σ)" ν, OF substSafe] by auto
      done
    have sem_eq:"⋀μ. (ν, μ) ∈ prog_sem I (Psubst a σ) ⟹ 
        ((μ, ω) ∈ prog_sem (local.adjoint I σ ν) b) =
        ((μ, ω) ∈ prog_sem (local.adjoint I σ μ) b)"
      subgoal for μ
      proof -
        assume assm:"(ν, μ) ∈ prog_sem I (Psubst a σ)"
        show "((μ, ω) ∈ prog_sem (local.adjoint I σ ν) b) = ((μ, ω) ∈ prog_sem (local.adjoint I σ μ) b)"
          using uadmit_prog_adjoint[OF PUA agree[OF assm] safe2 ssafe good_interp] by auto
      qed
      done      
    have "((ν, ω) ∈ prog_sem I (Psubst (a ;; b) σ)) = (∃ μ. (ν, μ) ∈ prog_sem I (Psubst a σ) ∧ (μ, ω) ∈ prog_sem I (Psubst b σ))"
      by auto
    moreover have "... = (∃ μ. (ν, μ) ∈ prog_sem I (Psubst a σ) ∧ (μ, ω) ∈ prog_sem (adjoint I σ μ) b)"
      using IH2[OF safe2 ssafe] by auto
    moreover have "... = (∃ μ. (ν, μ) ∈ prog_sem I (Psubst a σ) ∧ (μ, ω) ∈ prog_sem (adjoint I σ ν) b)"
      using sem_eq by auto
    moreover have "... = (∃ μ. (ν, μ) ∈ prog_sem (adjoint I σ ν) a ∧ (μ, ω) ∈ prog_sem (adjoint I σ ν) b)"
      using IH1[OF safe1 ssafe] by auto
    ultimately
    show "((ν, ω) ∈ prog_sem I (Psubst (a ;; b) σ)) = ((ν, ω) ∈ prog_sem (local.adjoint I σ ν) (a ;; b))"
      by auto
  qed
  then show ?case by auto
next
  case (Padmit_Loop σ a) then 
  have PA:"Padmit σ a"
    and PUA:"PUadmit σ a (BVP (Psubst a σ))"
    and IH:"hpsafe a ⟹ ssafe σ ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (Psubst a σ)) = ((ν, ω) ∈ prog_sem (local.adjoint I σ ν) a))"
    and substSafe:"hpsafe (Psubst a σ)"
    by auto
  have "hpsafe (a**) ⟹ ssafe σ ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (Psubst (a**) σ)) = ((ν, ω) ∈ prog_sem (local.adjoint I σ ν) (a**)))"
  proof -
    assume "hpsafe (a**)"
    then have hpsafe:"hpsafe a" by (auto dest: hpsafe.cases)
    assume ssafe:"ssafe σ"
    have agree:"⋀ν μ. (ν, μ) ∈ prog_sem I (Psubst a σ) ⟹ Vagree ν μ (-BVP(Psubst a σ))"
    subgoal for ν μ
      using bound_effect[OF good_interp, of "(Psubst a σ)" ν, OF substSafe] by auto
    done
  have sem_eq:"⋀ν μ ω. (ν, μ) ∈ prog_sem I (Psubst a σ) ⟹ 
      ((μ, ω) ∈ prog_sem (local.adjoint I σ ν) a) =
      ((μ, ω) ∈ prog_sem (local.adjoint I σ μ) a)"
    subgoal for ν μ ω 
    proof -
      assume assm:"(ν, μ) ∈ prog_sem I (Psubst a σ)"
      show "((μ, ω) ∈ prog_sem (local.adjoint I σ ν) a) = ((μ, ω) ∈ prog_sem (local.adjoint I σ μ) a)"
        using uadmit_prog_adjoint[OF PUA agree[OF assm] hpsafe ssafe good_interp] by auto
    qed
    done 
  fix ν ω
  have UN_rule:"⋀ a S S'. (⋀n b. (a,b) ∈ S n ⟷ (a,b) ∈ S' n) ⟹ (⋀b. (a,b) ∈ (⋃n. S n) ⟷ (a,b) ∈ (⋃n. S' n))"
    by auto
  have eqL:"((ν, ω) ∈ prog_sem I (Psubst (a**) σ)) = ((ν, ω) ∈ (⋃n. (prog_sem I (Psubst a σ)) ^^ n))"
    using rtrancl_is_UN_relpow by auto
  moreover have eachEq:"⋀n. ((⋀ν ω. ((ν, ω) ∈ (prog_sem I (Psubst a σ)) ^^ n) = ((ν, ω) ∈ (prog_sem (adjoint I σ ν) a)^^ n)))"
  proof -
    fix n
    show "((⋀ν ω. ((ν, ω) ∈ (prog_sem I (Psubst a σ)) ^^ n) = ((ν, ω) ∈ (prog_sem (adjoint I σ ν) a)^^ n)))"
    proof (induct n)
      case 0
      then show ?case by auto
    next
      case (Suc n) then
      have IH2:"⋀ν ω. ((ν, ω) ∈ prog_sem I (Psubst a σ) ^^ n) = ((ν, ω) ∈ prog_sem (local.adjoint I σ ν) a ^^ n)"
        by auto
      have relpow:"⋀R n. R ^^ Suc n = R O R ^^ n"
        using relpow.simps(2) relpow_commute by metis
      show ?case 
        apply (simp only: relpow[of n "prog_sem I (Psubst a σ)"] relpow[of n "prog_sem (adjoint I σ ν) a"])
        apply(unfold relcomp_unfold)
        apply auto
         subgoal for ab b
            apply(rule exI[where x=ab])
            apply(rule exI[where x=b])
            using IH2 IH[OF hpsafe ssafe] sem_eq[of ν "(ab,b)" ω] apply auto
             using uadmit_prog_adjoint[OF PUA agree hpsafe ssafe good_interp] IH[OF hpsafe ssafe]
             apply (metis (no_types, lifting)) 
            using uadmit_prog_adjoint[OF PUA agree hpsafe ssafe good_interp] IH[OF hpsafe ssafe]
            apply (metis (no_types, lifting)) 
          done
        subgoal for ab b
          apply(rule exI[where x=ab])
          apply(rule exI[where x=b])
          using IH2 IH[OF hpsafe ssafe] sem_eq[of ν "(ab,b)" ω] apply auto
           using uadmit_prog_adjoint[OF PUA agree hpsafe ssafe good_interp] IH[OF hpsafe ssafe]
           apply (metis (no_types, lifting))
          using uadmit_prog_adjoint[OF PUA agree hpsafe ssafe good_interp] IH[OF hpsafe ssafe]
          apply (metis (no_types, lifting))
        done
      done
    qed
  qed
  moreover have "((ν, ω) ∈ (⋃n. (prog_sem I (Psubst a σ)) ^^ n)) = ((ν, ω) ∈ (⋃ n.(prog_sem (adjoint I σ ν) a)^^ n))"
    apply(rule UN_rule)
    using eachEq by auto
  moreover have eqR:"((ν, ω) ∈ prog_sem (adjoint I σ ν) (a**)) = ((ν, ω) ∈ (⋃n. (prog_sem (adjoint I σ ν) a) ^^ n))"
     using rtrancl_is_UN_relpow by auto
  ultimately show "((ν, ω) ∈ prog_sem I (Psubst (a**) σ)) = ((ν, ω) ∈ prog_sem (local.adjoint I σ ν) (a**))"
    by auto
   qed
  then show ?case by auto
next
  case (Padmit_ODE σ ODE φ) then
  have OA:"Oadmit σ ODE (BVO ODE)"
    and FA:"Fadmit σ φ"
    and FUA:"FUadmit σ φ (BVO ODE)"
    and IH:"fsafe φ ⟹ ssafe σ ⟹ (⋀ν. (ν ∈ fml_sem I (Fsubst φ σ)) = (ν ∈ fml_sem (local.adjoint I σ ν) φ))"
      by auto
  have "hpsafe (EvolveODE ODE φ) ⟹
     ssafe σ ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (Psubst (EvolveODE ODE φ) σ)) = ((ν, ω) ∈ prog_sem (local.adjoint I σ ν) (EvolveODE ODE φ)))"
  proof (auto)
    fix aa ba bb
      and sol :: "real ⇒(real, 'sz) vec" 
      and t :: real
    assume ssafe:"ssafe σ"
    assume osafe:"osafe ODE"
    assume fsafe:"fsafe φ"
    assume t:"0 ≤ t"
    assume eq:"(aa,ba) = mk_v I (Osubst ODE σ) (sol 0, bb) (sol t)"
    assume sol:"(sol solves_ode (λa. ODE_sem I (Osubst ODE σ))) {0..t} 
      {x. mk_v I (Osubst ODE σ) (sol 0, bb) x ∈ fml_sem I (Fsubst φ σ)}"
    have silly:"
      ⋀t. mk_v I (Osubst ODE σ) (sol 0, bb) (sol t) = mk_v (local.adjoint I σ (sol t, bb)) ODE (sol 0, bb) (sol t)"
      subgoal for t using subst_mkv[OF good_interp OA osafe ssafe, of "(sol 0, bb)" "(sol t, bb)"] by auto done
    have hmmsubst:"⋀s. s ∈ {0..t} ⟹ Vagree (sol 0,bb) (sol s, bb) (-(BVO (Osubst ODE σ)))"
      subgoal for s
        apply (rule ODE_bound_effect[of s])
         apply auto[1]
        by (rule sol)
      done
    have sub:"(-(BVO ODE)) ⊆ (-(BVO (Osubst ODE σ)))"
      by(induction ODE, auto)
    have hmm:"⋀s. s ∈ {0..t} ⟹ Vagree (sol 0,bb) (sol s, bb) (-(BVO ODE))"
      subgoal for s
        using agree_sub[OF sub hmmsubst[of s]] by auto
      done
    from hmm have hmm':"⋀s. s ∈ {0..t} ⟹ VSagree (sol 0) (sol s) {x. Inl x ∈ (-(BVO ODE))}"
      unfolding VSagree_def Vagree_def by auto
    note hmmm = hmmsubst
    from hmmm have hmmm':"⋀s. s ∈ {0..t} ⟹ VSagree (sol 0) (sol s) {x. Inl x ∈ (-(BVO (Osubst ODE σ)))}"
      unfolding VSagree_def Vagree_def by auto
    have Vagree_of_VSagree:"⋀ν1 ν2 ω1 ω2 S. VSagree ν1 ν2 {x. Inl x ∈ S} ⟹ VSagree ω1 ω2 {x. Inr x ∈ S} ⟹ Vagree (ν1, ω1) (ν2, ω2) S"
      unfolding VSagree_def Vagree_def by auto
    have mkv:"⋀s. s ∈ {0..t} ⟹ mk_v I (Osubst ODE σ) (sol 0, bb) (sol s) = mk_v (adjoint I σ (sol s, bb)) ODE (sol 0, bb) (sol s)"
      subgoal for s by (rule silly[of s])
      done
    have lem:"⋀ODE. Oadmit σ ODE (BVO ODE) ⟹ (⋃i∈{i |i. Inl i ∈ SIGO ODE}. case SFunctions σ i of None ⇒ {} | Some x ⇒ FVT x) ⊆ (-(BVO ODE))"
      subgoal for ODE
        apply(induction rule: Oadmit.induct)
          apply auto
        subgoal for σ θ U x xa
          apply (cases "SFunctions σ xa")
           apply auto
          unfolding TUadmit_def
        proof -
          fix a
          assume un:"(⋃i∈SIGT θ. case SFunctions σ i of None ⇒ {} | Some x ⇒ FVT x) ∩ U = {}"
          assume sig:"xa ∈ SIGT θ"
          assume some:"SFunctions σ xa = Some a"
          assume fvt:"x ∈ FVT a"
          assume xU:"x ∈ U"
          from un sig have "(case SFunctions σ xa of None ⇒ {} | Some x ⇒ FVT x) ∩ U = {}"
            by auto 
          then have "(FVT a) ∩ U = {}"
           using some by auto
          then show "False" using fvt xU by auto
        qed
        done
      done
    have FVT_sub:"(⋃i∈{i |i. Inl i ∈ SIGO ODE}. case SFunctions σ i of None ⇒ {} | Some x ⇒ FVT x) ⊆ (-(BVO ODE))"
      using lem[OF OA] by auto
    have agrees: "⋀s. s ∈ {0..t} ⟹ Vagree (sol 0,bb) (sol s, bb) (⋃i∈{i |i. Inl i ∈ SIGO ODE}. case SFunctions σ i of None ⇒ {} | Some x ⇒ FVT x)"
       subgoal for s using agree_sub[OF FVT_sub hmm[of s]] by auto done
    have "⋀s. s ∈ {0..t} ⟹ mk_v (adjoint I σ (sol 0, bb)) ODE = mk_v (adjoint I σ (sol s, bb)) ODE"
      subgoal for s         
        apply (rule uadmit_mkv_adjoint)
           prefer 3
          subgoal using agrees by auto
         using OA hmm[of s] unfolding  Vagree_def
        using ssafe good_interp osafe by auto
      done
    then have mkva:"⋀s. s ∈ {0..t} ⟹ mk_v (adjoint I σ (sol s, bb)) ODE (sol 0, bb) (sol s) = mk_v (adjoint I σ (sol 0, bb)) ODE (sol 0, bb) (sol s)"
      by presburger
    have main_eq:"⋀s. s ∈ {0..t} ⟹  mk_v I (Osubst ODE σ) (sol 0, bb) (sol s) = mk_v (adjoint I σ (sol 0, bb)) ODE (sol 0, bb) (sol s) "
      using mkv mkva by auto
    note mkvt = main_eq[of t]
    have fml_eq1:"⋀s. s ∈ {0..t} ⟹ 
        (mk_v I (Osubst ODE σ) (sol 0, bb) (sol s) ∈ fml_sem I (Fsubst φ σ)) 
      = (mk_v I (Osubst ODE σ) (sol 0, bb) (sol s) ∈ fml_sem (adjoint I σ (mk_v I (Osubst ODE σ) (sol 0, bb) (sol s))) φ)"
      using IH[OF fsafe ssafe] by auto
    have fml_vagree:"⋀s. s ∈ {0..t} ⟹ Vagree (mk_v I (Osubst ODE σ) (sol 0, bb) (sol s)) (sol 0, bb) (- semBV I (Osubst ODE σ))"
      subgoal for s
        using mk_v_agree[of I "Osubst ODE σ" "(sol 0,bb)" "sol s"] osubst_eq_ODE_vars[of I ODE σ]
        unfolding Vagree_def
        by auto
      done
    have sembv_eq:"semBV I (Osubst ODE σ) = semBV (adjoint I σ (sol 0, bb)) ODE"
      using subst_semBV by auto
    have fml_vagree':"⋀s. s ∈ {0..t} ⟹ Vagree (mk_v I (Osubst ODE σ) (sol 0, bb) (sol s)) (sol 0, bb) (- semBV (adjoint I σ (sol 0,bb)) ODE)"
      using sembv_eq fml_vagree by auto
    have mysub:"-BVO ODE ⊆ -(semBV I (Osubst ODE σ))"
      by(induction ODE,auto)
    have fml_vagree:"⋀s. s ∈ {0..t} ⟹ Vagree (mk_v I (Osubst ODE σ) (sol 0, bb) (sol s)) (sol 0, bb) (- BVO ODE)"
      subgoal for s using agree_sub[OF mysub fml_vagree[of s]] by auto done
    have fml_sem_eq:"⋀s. s ∈ {0..t} ⟹ fml_sem (adjoint I σ (mk_v I (Osubst ODE σ) (sol 0, bb) (sol s))) φ = fml_sem (adjoint I σ (sol 0, bb)) φ"
      apply (rule uadmit_fml_adjoint)
          using FUA fsafe ssafe  good_interp fml_vagree by auto
    have fml_eq2:"⋀s. s ∈ {0..t} ⟹ 
      ((mk_v I (Osubst ODE σ) (sol 0, bb) (sol s) ∈ fml_sem (adjoint I σ (mk_v I (Osubst ODE σ) (sol 0, bb) (sol s))) φ)
      =(mk_v I (Osubst ODE σ) (sol 0, bb) (sol s) ∈ fml_sem (adjoint I σ (sol 0, bb)) φ))"
      using fml_sem_eq by auto
    have fml_eq3:"⋀s. s ∈ {0..t} ⟹
      (mk_v I (Osubst ODE σ) (sol 0, bb) (sol s) ∈ fml_sem (adjoint I σ (sol 0, bb)) φ) = (mk_v (adjoint I σ (sol 0,bb)) ODE (sol 0, bb) (sol s) ∈ fml_sem (adjoint I σ (sol 0, bb)) φ) "
      using main_eq by auto
    have fml_eq: "⋀s. s ∈ {0..t} ⟹
      (mk_v I (Osubst ODE σ) (sol 0, bb) (sol s) ∈ fml_sem I (Fsubst φ σ)) 
       =  (mk_v (adjoint I σ (sol 0, bb)) ODE (sol 0, bb) (sol s) ∈ fml_sem (adjoint I σ (sol 0, bb)) φ)"
      using fml_eq1 fml_eq2 fml_eq3 by meson
    have sem_eq:"⋀t. ODE_sem I (Osubst ODE σ) (sol t) = ODE_sem (adjoint I σ (sol t, bb)) ODE (sol t)"
      subgoal for t
        using subst_ode[OF good_interp osafe ssafe OA, of "(sol t,bb)"] by auto
      done
    have sem_fact:"⋀s. s ∈ {0..t} ⟹ ODE_sem I (Osubst ODE σ) (sol s) = ODE_sem (adjoint I σ (sol 0, bb)) ODE (sol s)"
      subgoal for s
        using subst_ode[OF good_interp osafe ssafe OA, of "(sol s, bb)"]
        uadmit_ode_adjoint'[OF ssafe good_interp agrees[of s] osafe] 
        by auto
      done
    have sol':"(sol solves_ode (λ_. ODE_sem (adjoint I σ (sol 0, bb)) ODE)) {0..t}
       {x. mk_v I (Osubst ODE σ) (sol 0, bb) x ∈ fml_sem I (Fsubst φ σ)}"
      apply (rule solves_ode_congI)
          apply (rule sol)
         subgoal for ta by auto
        subgoal for ta by (rule sem_fact[of ta])
       subgoal by (rule refl)
      subgoal by (rule refl)
      done
    have sub:"⋀s. s ∈ {0..t} 
            ⟹ sol s ∈ {x. (mk_v (adjoint I σ (sol 0,bb)) ODE (sol 0, bb) x ∈ fml_sem (adjoint I σ (sol 0, bb)) φ)}"
      using fml_eq rangeI t sol solves_ode_domainD by fastforce
    have sol'':"(sol solves_ode (λc. ODE_sem (adjoint I σ (sol 0, bb)) ODE)) {0..t}
{x. mk_v (adjoint I σ (sol 0, bb)) ODE (sol 0, bb) x ∈ fml_sem (adjoint I σ (sol 0, bb)) φ}"
      apply (rule solves_odeI)
       subgoal using sol' solves_ode_vderivD by blast
      using sub by auto
    show "∃sola. sol 0 = sola 0 ∧
      (∃ta. mk_v I (Osubst ODE σ) (sol 0, bb) (sol t) = mk_v (local.adjoint I σ (sol 0, bb)) ODE (sola 0, bb) (sola ta) ∧
            0 ≤ ta ∧
            (sola solves_ode (λa. ODE_sem (local.adjoint I σ (sol 0, bb)) ODE)) {0..ta}
             {x. mk_v (local.adjoint I σ (sol 0, bb)) ODE (sola 0, bb) x ∈ fml_sem (local.adjoint I σ (sol 0, bb)) φ})"
    apply(rule exI[where x=sol])
    apply(rule conjI)
     subgoal by (rule refl)
    apply(rule exI[where x=t])
    apply(rule conjI)
     subgoal using  mkvt t by auto
    apply(rule conjI)
     subgoal by (rule t)
    subgoal by (rule sol'') 
    done
  next
    fix aa ba bb 
      and sol::"real ⇒ (real, 'sz) vec" 
      and t::real
    assume ssafe:"ssafe σ"
    assume osafe:"osafe ODE"
    assume fsafe:"fsafe φ"
      
    assume eq:"(aa,ba) = mk_v (adjoint I σ (sol 0, bb)) ODE (sol 0, bb) (sol t)"
    assume t:"0 ≤ t"
    assume sol:"(sol solves_ode (λa. ODE_sem (adjoint I σ (sol 0, bb)) ODE)) {0..t}
    {x. mk_v (adjoint I σ (sol 0, bb)) ODE (sol 0, bb) x ∈ fml_sem (adjoint I σ (sol 0, bb)) φ}"
    have silly:"
      ⋀t. mk_v I (Osubst ODE σ) (sol 0, bb) (sol t) = mk_v (local.adjoint I σ (sol t, bb)) ODE (sol 0, bb) (sol t)"
      subgoal for t using subst_mkv[OF good_interp OA osafe ssafe, of "(sol 0, bb)" "(sol t, bb)"] by auto done
    have hmm:"⋀s. s ∈ {0..t} ⟹ Vagree (sol 0,bb) (sol s, bb) (-(BVO ODE))"
      subgoal for s
        apply (rule ODE_bound_effect[of s])
         apply auto[1]
        by (rule sol)
      done
    from hmm have hmm':"⋀s. s ∈ {0..t} ⟹ VSagree (sol 0) (sol s) {x. Inl x ∈ (-(BVO ODE))}"
      unfolding VSagree_def Vagree_def by auto
    have Vagree_of_VSagree:"⋀ν1 ν2 ω1 ω2 S. VSagree ν1 ν2 {x. Inl x ∈ S} ⟹ VSagree ω1 ω2 {x. Inr x ∈ S} ⟹ Vagree (ν1, ω1) (ν2, ω2) S"
      unfolding VSagree_def Vagree_def by auto
    have mkv:"⋀s. s ∈ {0..t} ⟹ mk_v I (Osubst ODE σ) (sol 0, bb) (sol s) = mk_v (adjoint I σ (sol s, bb)) ODE (sol 0, bb) (sol s)"
      subgoal for s by (rule silly[of s])
      done
    have lem:"⋀ODE. Oadmit σ ODE (BVO ODE) ⟹ (⋃i∈{i |i. Inl i ∈ SIGO ODE}. case SFunctions σ i of None ⇒ {} | Some x ⇒ FVT x) ⊆ (-(BVO ODE))"
      subgoal for ODE
        apply(induction rule: Oadmit.induct)
        apply auto
        subgoal for σ θ U x xa
        apply (cases "SFunctions σ xa")
         apply auto
        unfolding TUadmit_def
     proof -
       fix a
       assume un:"(⋃i∈SIGT θ. case SFunctions σ i of None ⇒ {} | Some x ⇒ FVT x) ∩ U = {}"
       assume sig:"xa ∈ SIGT θ"
       assume some:"SFunctions σ xa = Some a"
       assume fvt:"x ∈ FVT a"
       assume xU:"x ∈ U"
       from un sig have "(case SFunctions σ xa of None ⇒ {} | Some x ⇒ FVT x) ∩ U = {}"
         by auto 
       then have "(FVT a) ∩ U = {}"
        using some by auto
       then show "False" using fvt xU by auto
     qed
       done
     done
    have FVT_sub:"(⋃i∈{i |i. Inl i ∈ SIGO ODE}. case SFunctions σ i of None ⇒ {} | Some x ⇒ FVT x) ⊆ (-(BVO ODE))"
      using lem[OF OA] by auto
    have agrees: "⋀s. s ∈ {0..t} ⟹ Vagree (sol 0,bb) (sol s, bb) (⋃i∈{i |i. Inl i ∈ SIGO ODE}. case SFunctions σ i of None ⇒ {} | Some x ⇒ FVT x)"
       subgoal for s using agree_sub[OF FVT_sub hmm[of s]] by auto done
    have "⋀s. s ∈ {0..t} ⟹ mk_v (adjoint I σ (sol 0, bb)) ODE = mk_v (adjoint I σ (sol s, bb)) ODE"
      subgoal for s         
        apply (rule uadmit_mkv_adjoint)
           prefer 3
          subgoal using agrees by auto
         using OA hmm[of s] unfolding  Vagree_def
        using ssafe good_interp osafe by auto
      done
    then have mkva:"⋀s. s ∈ {0..t} ⟹ mk_v (adjoint I σ (sol s, bb)) ODE (sol 0, bb) (sol s) = mk_v (adjoint I σ (sol 0, bb)) ODE (sol 0, bb) (sol s)"
      by presburger
    have main_eq:"⋀s. s ∈ {0..t} ⟹  mk_v I (Osubst ODE σ) (sol 0, bb) (sol s) = mk_v (adjoint I σ (sol 0, bb)) ODE (sol 0, bb) (sol s) "
      using mkv mkva by auto
    note mkvt = main_eq[of t]
    have fml_eq1:"⋀s. s ∈ {0..t} ⟹ 
        (mk_v I (Osubst ODE σ) (sol 0, bb) (sol s) ∈ fml_sem I (Fsubst φ σ)) 
      = (mk_v I (Osubst ODE σ) (sol 0, bb) (sol s) ∈ fml_sem (adjoint I σ (mk_v I (Osubst ODE σ) (sol 0, bb) (sol s))) φ)"
      using IH[OF fsafe ssafe] by auto
    have fml_vagree:"⋀s. s ∈ {0..t} ⟹ Vagree (mk_v I (Osubst ODE σ) (sol 0, bb) (sol s)) (sol 0, bb) (- semBV I (Osubst ODE σ))"
      subgoal for s
        using mk_v_agree[of I "Osubst ODE σ" "(sol 0,bb)" "sol s"] osubst_eq_ODE_vars[of I ODE σ]
        unfolding Vagree_def
        by auto
      done
    have sembv_eq:"semBV I (Osubst ODE σ) = semBV (adjoint I σ (sol 0, bb)) ODE"
      using subst_semBV by auto
    have fml_vagree':"⋀s. s ∈ {0..t} ⟹ Vagree (mk_v I (Osubst ODE σ) (sol 0, bb) (sol s)) (sol 0, bb) (- semBV (adjoint I σ (sol 0,bb)) ODE)"
      using sembv_eq fml_vagree by auto
    have mysub:"-BVO ODE ⊆ -(semBV I (Osubst ODE σ))"
      by(induction ODE,auto)
    have fml_vagree:"⋀s. s ∈ {0..t} ⟹ Vagree (mk_v I (Osubst ODE σ) (sol 0, bb) (sol s)) (sol 0, bb) (- BVO ODE)"
      subgoal for s using agree_sub[OF mysub fml_vagree[of s]] by auto done
    have fml_sem_eq:"⋀s. s ∈ {0..t} ⟹ fml_sem (adjoint I σ (mk_v I (Osubst ODE σ) (sol 0, bb) (sol s))) φ = fml_sem (adjoint I σ (sol 0, bb)) φ"
      apply (rule uadmit_fml_adjoint)
      using FUA fsafe ssafe  good_interp fml_vagree by auto
    have fml_eq2:"⋀s. s ∈ {0..t} ⟹ 
      ((mk_v I (Osubst ODE σ) (sol 0, bb) (sol s) ∈ fml_sem (adjoint I σ (mk_v I (Osubst ODE σ) (sol 0, bb) (sol s))) φ)
      =(mk_v I (Osubst ODE σ) (sol 0, bb) (sol s) ∈ fml_sem (adjoint I σ (sol 0, bb)) φ))"
      using fml_sem_eq by auto
    have fml_eq3:"⋀s. s ∈ {0..t} ⟹
        (mk_v I (Osubst ODE σ) (sol 0, bb) (sol s) ∈ fml_sem (adjoint I σ (sol 0, bb)) φ) = (mk_v (adjoint I σ (sol 0,bb)) ODE (sol 0, bb) (sol s) ∈ fml_sem (adjoint I σ (sol 0, bb)) φ) "
      using main_eq by auto
    have fml_eq: "⋀s. s ∈ {0..t} ⟹
         (mk_v I (Osubst ODE σ) (sol 0, bb) (sol s) ∈ fml_sem I (Fsubst φ σ)) 
          =  (mk_v (adjoint I σ (sol 0, bb)) ODE (sol 0, bb) (sol s) ∈ fml_sem (adjoint I σ (sol 0, bb)) φ)"
         using fml_eq1 fml_eq2 fml_eq3 by meson
    have sem_eq:"⋀t. ODE_sem I (Osubst ODE σ) (sol t) = ODE_sem (adjoint I σ (sol t, bb)) ODE (sol t)"
      subgoal for t
        using subst_ode[OF good_interp osafe ssafe OA, of "(sol t,bb)"] by auto
      done
    have sem_fact:"⋀s. s ∈ {0..t} ⟹ ODE_sem I (Osubst ODE σ) (sol s) = ODE_sem (adjoint I σ (sol 0, bb)) ODE (sol s)"
      subgoal for s
        using subst_ode[OF good_interp osafe ssafe OA, of "(sol s, bb)"]
        uadmit_ode_adjoint'[OF ssafe good_interp agrees[of s] osafe] 
        by auto
      done
    have sub:"⋀s. s ∈ {0..t} 
            ⟹ sol s ∈ {x. mk_v I (Osubst ODE σ) (sol 0, bb) (sol s) ∈ fml_sem I (Fsubst φ σ)}"
      using fml_eq rangeI t sol solves_ode_domainD by fastforce
    have sol':"(sol solves_ode (λa. ODE_sem I (Osubst ODE σ))) {0..t} {x. mk_v (adjoint I σ (sol 0, bb)) ODE (sol 0, bb) x ∈ fml_sem (adjoint I σ (sol 0, bb)) φ}"
      apply (rule solves_ode_congI)
          apply (rule sol)
         subgoal for ta by auto
        subgoal for ta using sem_fact[of ta] by auto
       subgoal by (rule refl)
      subgoal by (rule refl)
      done
    have sol'':"(sol solves_ode (λa. ODE_sem I (Osubst ODE σ))) {0..t} {x. mk_v I (Osubst ODE σ) (sol 0, bb) x ∈ fml_sem I (Fsubst φ σ)}"
      apply (rule solves_odeI)
       subgoal using sol' solves_ode_vderivD by blast
      subgoal for ta using sub[of ta] apply auto 
        by (meson empty_iff)
      done
  show "∃sola. sol 0 = sola 0 ∧
        (∃ta. mk_v (adjoint I σ (sol 0, bb)) ODE (sol 0, bb) (sol t) = mk_v I (Osubst ODE σ) (sola 0, bb) (sola ta) ∧
              0 ≤ ta ∧
              (sola solves_ode (λa. ODE_sem I (Osubst ODE σ))) {0..ta} {x. mk_v I (Osubst ODE σ) (sola 0, bb) x ∈ fml_sem I (Fsubst φ σ)})"
    apply(rule exI[where x=sol])
    apply(rule conjI)
     subgoal by (rule refl)
    apply(rule exI[where x=t])
    apply(rule conjI)
     subgoal using  mkvt t by auto
    apply(rule conjI)
     subgoal by (rule t)
    subgoal using sol'' by auto 
    done
  qed
  then show "?case" by auto 
next
  case (Padmit_Choice σ a b) then 
  have IH1:"hpsafe a ⟹ ssafe σ ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (Psubst a σ)) = ((ν, ω) ∈ prog_sem (local.adjoint I σ ν) a))"
    and IH2:"hpsafe b ⟹ ssafe σ ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (Psubst b σ)) = ((ν, ω) ∈ prog_sem (local.adjoint I σ ν) b))"
    by blast+
  have hpsafe1:"hpsafe (a ∪∪ b) ⟹ hpsafe a" 
    and hpsafe2:"hpsafe (a ∪∪ b) ⟹ hpsafe b" 
    by (auto dest: hpsafe.cases)
  show ?case using IH1[OF hpsafe1] IH2[OF hpsafe2] by auto
next
  case (Padmit_Assign σ θ x) then
  have TA:"Tadmit σ θ" by auto
  have "hpsafe (Assign x θ) ⟹ ssafe σ ⟹  (⋀ν ω. ((ν, ω) ∈ prog_sem I (Psubst (Assign x θ) σ)) = ((ν, ω) ∈ prog_sem (adjoint I σ ν) (Assign x θ)))"
  proof -
    assume hpsafe:"hpsafe (Assign x θ)"
    assume ssafe:"ssafe σ"
    from ssafe have ssafes:"(⋀i f'. SFunctions σ i = Some f' ⟹ dfree f')"
        "(⋀f f'. SPredicates σ f = Some f' ⟹ fsafe f')"
        unfolding ssafe_def by auto
    from hpsafe have dsafe:"dsafe θ" by (auto elim: hpsafe.cases)
    fix ν ω
    show "?thesis ν ω"
      using subst_dterm[OF good_interp TA dsafe ssafes]
      by auto
  qed
  then show ?case by auto
next
  case (Padmit_DiffAssign σ θ x) then
  have TA:"Tadmit σ θ" by auto
  have "hpsafe (DiffAssign x θ) ⟹ ssafe σ ⟹  (⋀ν ω. ((ν, ω) ∈ prog_sem I (Psubst (DiffAssign x θ) σ)) = ((ν, ω) ∈ prog_sem (adjoint I σ ν) (DiffAssign x θ)))"
  proof -
    assume hpsafe:"hpsafe (DiffAssign x θ)"
    assume ssafe:"ssafe σ"
    from ssafe have ssafes:"(⋀i f'. SFunctions σ i = Some f' ⟹ dfree f')"
        "(⋀f f'. SPredicates σ f = Some f' ⟹ fsafe f')"
        unfolding ssafe_def by auto
    from hpsafe have dsafe:"dsafe θ" by (auto elim: hpsafe.cases)
    fix ν ω
    show "?thesis ν ω"
      using subst_dterm[OF good_interp TA dsafe ssafes]
      by auto
  qed
  then show ?case by auto
next
  case (Padmit_Test σ φ) then
  have IH:"fsafe φ ⟹ ssafe σ ⟹ (⋀ν. (ν ∈ fml_sem I (Fsubst φ σ)) = (ν ∈ fml_sem (local.adjoint I σ ν) φ))"
    by auto
  have "hpsafe (? φ) ⟹ ssafe σ ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (Psubst (? φ) σ)) = ((ν, ω) ∈ prog_sem (local.adjoint I σ ν) (? φ)))"
  proof -
    assume hpsafe:"hpsafe (? φ)"
    from hpsafe have fsafe:"fsafe φ" by (auto dest: hpsafe.cases)
    assume ssafe:"ssafe σ"
    fix ν ω
    show "?thesis ν ω" using IH[OF fsafe ssafe] by auto
  qed
  then show ?case by auto
next
  case (Fadmit_Geq σ θ1 θ2) then 
  have TA1:"Tadmit σ θ1" and TA2:"Tadmit σ θ2"
    by auto
  have "fsafe (Geq θ1 θ2) ⟹ ssafe σ ⟹ (⋀ν. (ν ∈ fml_sem I (Fsubst (Geq θ1 θ2) σ)) = (ν ∈ fml_sem (local.adjoint I σ ν) (Geq θ1 θ2)))"
  proof -
    assume fsafe:"fsafe (Geq θ1 θ2)"
    assume ssafe:"ssafe σ"
    from fsafe have dsafe1:"dsafe θ1" and dsafe2:"dsafe θ2"
      by (auto dest: fsafe.cases)
    from ssafe have ssafes:"(⋀i f'. SFunctions σ i = Some f' ⟹ dfree f')"
      "(⋀f f'. SPredicates σ f = Some f' ⟹ fsafe f')"
      unfolding ssafe_def by auto
    fix ν
    show "?thesis ν" using 
      subst_dterm[OF good_interp TA1 dsafe1 ssafes]
      subst_dterm[OF good_interp TA2 dsafe2 ssafes]
      by auto 
  qed
  then show ?case by auto 
next 
  case (Fadmit_Prop1 σ args p p') then
    have TA:"⋀i. Tadmit σ (args i)"
    and some:"SPredicates σ p = Some p'"
    and NFA:"NFadmit (λi. Tsubst (args i) σ) p'"
    and substSafes:"⋀i. dsafe (Tsubst (args i) σ)"
      by auto
    have "fsafe ($φ p args) ⟹
         ssafe σ ⟹ (⋀ν. (ν ∈ fml_sem I (Fsubst ($φ p args) σ)) = (ν ∈ fml_sem (local.adjoint I σ ν) ($φ p args)))"
    proof -
      assume fsafe:"fsafe ($φ p args)"
      assume ssafe:"ssafe σ"
      from ssafe have ssafes:"(⋀i f'. SFunctions σ i = Some f' ⟹ dfree f')"
      "(⋀f f'. SPredicates σ f = Some f' ⟹ fsafe f')"
      unfolding ssafe_def by auto
      fix ν
      from fsafe have safes:"⋀i. dsafe (args i)" using dfree_is_dsafe by auto
      have IH:"(⋀ν'. ⋀i. dsafe (args i) ⟹
          dterm_sem I (Tsubst (args i) σ) ν = dterm_sem (adjoint I σ ν) (args i) ν)" 
        using  subst_dterm[OF good_interp TA safes ssafes] by auto
      have eqs:"⋀i ν'. dterm_sem I (Tsubst (args i) σ) ν = dterm_sem (adjoint I σ ν) (args i) ν"
        by (auto simp add: IH safes)
      let ?sub = "(λ i. Tsubst (args i) σ)"
      have freef:"fsafe p'" using ssafe some unfolding ssafe_def by auto 
      have IH2:"(ν ∈ fml_sem I (FsubstFO p' ?sub)) = (ν ∈ fml_sem (adjointFO I ?sub ν) p')"
        using nsubst_fml good_interp NFA freef substSafes
        by blast
      have vec:"(χ i. dterm_sem I (Tsubst (args i) σ) ν) = (χ i. dterm_sem (local.adjoint I σ ν) (args i) ν)"
        apply(auto simp add: vec_eq_iff)
        subgoal for i
          using IH[of i, OF safes[of i]] 
          by auto
        done
      show "?thesis ν" 
        using IH safes eqs apply (auto simp add:  IH2  some good_interp)
        using some unfolding adjoint_def adjointFO_def by auto
    qed
  then show "?case" by auto
next
  case (Fadmit_Prop2 σ args p) 
  note TA = Fadmit_Prop2.hyps(1)
    and none = Fadmit_Prop2.hyps(2)
  have "fsafe (Prop p args) ⟹ ssafe σ ⟹ (⋀ν.(ν ∈ fml_sem I (Fsubst ($φ p args) σ)) = (ν ∈ fml_sem (local.adjoint I σ ν) ($φ p args)))"
  proof -
    assume safe:"fsafe (Prop p args)" and ssafe:"ssafe σ"
    from ssafe have ssafes:"(⋀i f'. SFunctions σ i = Some f' ⟹ dfree f')"
        "(⋀f f'. SPredicates σ f = Some f' ⟹ fsafe f')"
        unfolding ssafe_def by auto
    fix ν
    from safe have  safes:"⋀i. dsafe (args i)" using dfree_is_dsafe by auto
    have IH:"(⋀ν'. ⋀i. dsafe (args i) ⟹
        dterm_sem I (Tsubst (args i) σ) ν = dterm_sem (adjoint I σ ν) (args i) ν)" 
    using  subst_dterm[OF good_interp TA safes ssafes] by auto
    have Ieq:"Predicates I p = Predicates (adjoint I σ ν) p"
      using none unfolding adjoint_def by auto
    have vec:"(χ i. dterm_sem I (Tsubst (args i) σ) ν) = (χ i. dterm_sem (adjoint I σ ν) (args i) ν)"
      apply(auto simp add: vec_eq_iff)
      subgoal for i using IH[of i, OF safes[of i]] by auto
      done
    show "?thesis ν" using none IH Ieq vec by auto
  qed
  then show "?case" by auto
next
  case (Fadmit_Not σ φ) then 
  have IH:"fsafe φ ⟹ ssafe σ ⟹ (⋀ν. (ν ∈ fml_sem I (Fsubst φ σ)) = (ν ∈ fml_sem (local.adjoint I σ ν) φ))"
    by blast
  have fsafe:"fsafe (Not φ) ⟹ fsafe φ"
    by (auto dest: fsafe.cases)
  show ?case using IH[OF fsafe] by auto
next
  case (Fadmit_And σ φ ψ) then
    have IH1:"fsafe φ ⟹ ssafe σ ⟹ (⋀ν. (ν ∈ fml_sem I (Fsubst φ σ)) = (ν ∈ fml_sem (local.adjoint I σ ν) φ))"
      and IH2:"fsafe ψ ⟹ ssafe σ ⟹ (⋀ν. (ν ∈ fml_sem I (Fsubst ψ σ)) = (ν ∈ fml_sem (local.adjoint I σ ν) ψ))"
      by (blast)+
    have fsafe1:"fsafe (φ && ψ) ⟹ fsafe φ" and fsafe2:"fsafe (φ && ψ) ⟹ fsafe ψ" 
      by (auto dest: fsafe.cases)
    show ?case using IH1[OF fsafe1] IH2[OF fsafe2] by auto
next
  case (Fadmit_Exists σ φ x)
  then have IH:"fsafe φ ⟹ ssafe σ ⟹ (⋀ν. (ν ∈ fml_sem I (Fsubst φ σ)) = (ν ∈ fml_sem (local.adjoint I σ ν) φ))"
    and FUA:"FUadmit σ φ {Inl x}"
    by blast+
  have fsafe:"fsafe (Exists x φ) ⟹ fsafe φ"
    by (auto dest: fsafe.cases)
  have eq:"fsafe (Exists x φ) ⟹ ssafe σ ⟹ (⋀ν. (ν ∈ fml_sem I (Fsubst  (Exists x φ) σ)) = (ν ∈ fml_sem (local.adjoint I σ ν)  (Exists x φ)))"
  proof -
    assume fsafe:"fsafe (Exists x φ)"
    from fsafe have fsafe':"fsafe φ" by (auto dest: fsafe.cases)
    assume ssafe:"ssafe σ"
    fix ν
    have agree:"⋀r. Vagree ν (repv ν x r) (- {Inl x})"
      unfolding Vagree_def by auto
    have sem_eq:"⋀r. ((repv ν x r) ∈ fml_sem (local.adjoint I σ (repv ν x r)) φ) =
                      ((repv ν x r) ∈ fml_sem (local.adjoint I σ ν) φ)"
      using uadmit_fml_adjoint[OF FUA agree fsafe' ssafe good_interp] by auto
    have "(ν ∈ fml_sem I (Fsubst  (Exists x φ) σ)) = (∃r. (repv ν x r) ∈ fml_sem I (Fsubst φ σ))"
      by auto
    moreover have "... = (∃r. (repv ν x r) ∈ fml_sem (local.adjoint I σ (repv ν x r)) φ)"
      using IH[OF fsafe' ssafe] by auto
    moreover have "... = (∃r. (repv ν x r) ∈ fml_sem (local.adjoint I σ ν) φ)"
      using sem_eq by auto
    moreover have "... = (ν ∈ fml_sem (adjoint I σ ν) (Exists x φ))"
      by auto
    ultimately show "(ν ∈ fml_sem I (Fsubst  (Exists x φ) σ)) = (ν ∈ fml_sem (local.adjoint I σ ν)  (Exists x φ))"
      by auto
    qed
  then show ?case by auto
next
  case (Fadmit_Diamond σ φ a) then 
    have PA:"Padmit σ a" 
      and FUA:"FUadmit σ φ (BVP (Psubst a σ))"
      and IH1:"fsafe φ ⟹ ssafe σ ⟹ (⋀ν. (ν ∈ fml_sem I (Fsubst φ σ)) = (ν ∈ fml_sem (adjoint I σ ν) φ))"
      and IH2:"hpsafe a ⟹ ssafe σ ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (Psubst a σ)) = ((ν, ω) ∈ prog_sem (adjoint I σ ν) a))"
      and substSafe:"hpsafe (Psubst a σ)"
      by auto
    have "fsafe (⟨ a ⟩ φ) ⟹ ssafe σ ⟹ (⋀ν. (ν ∈ fml_sem I (Fsubst (⟨ a ⟩ φ) σ)) = (ν ∈ fml_sem (local.adjoint I σ ν) (⟨ a ⟩ φ)))"
    proof -
      assume fsafe:"fsafe (⟨ a ⟩ φ)"
      assume ssafe:"ssafe σ"
      from fsafe have fsafe':"fsafe φ" and hpsafe:"hpsafe a" by (auto dest: fsafe.cases)
      fix ν
      have agree:"⋀ω. (ν, ω) ∈ prog_sem I (Psubst a σ) ⟹ Vagree ν ω (-BVP(Psubst a σ))"
        using bound_effect[OF good_interp, of "(Psubst a σ)" ν, OF substSafe] by auto
      have sem_eq:"⋀ω. (ν, ω) ∈ prog_sem I (Psubst a σ) ⟹ 
          (ω ∈ fml_sem (local.adjoint I σ ν) φ) =
          (ω ∈ fml_sem (local.adjoint I σ ω) φ)"
        using uadmit_fml_adjoint[OF FUA agree fsafe' ssafe good_interp] by auto
      have "(ν ∈ fml_sem I (Fsubst (⟨ a ⟩ φ) σ)) = (∃ ω. (ν, ω) ∈ prog_sem I (Psubst a σ) ∧ ω ∈ fml_sem I (Fsubst φ σ))"
        by auto
      moreover have "... = (∃ ω. (ν, ω) ∈ prog_sem (adjoint I σ ν) a ∧ ω ∈ fml_sem (adjoint I σ ω) φ)"
        using IH1[OF fsafe' ssafe] IH2[OF hpsafe ssafe, of ν] by auto
      moreover have "... = (∃ ω. (ν, ω) ∈ prog_sem (adjoint I σ ν) a ∧ ω ∈ fml_sem (adjoint I σ ν) φ)"
        using sem_eq IH2 hpsafe ssafe by blast
      moreover have "... = (ν ∈ fml_sem (adjoint I σ ν) (⟨ a ⟩ φ))"
        by auto
      ultimately show "?thesis ν" by auto
    qed
  then show ?case by auto
next
   case (Fadmit_Prop1 σ args p p') 
   have "fsafe(Prop p args) ⟹ ssafe σ ⟹ (⋀ν.(ν ∈ fml_sem I (Fsubst ($φ p args) σ)) = (ν ∈ fml_sem (local.adjoint I σ ν) ($φ p args)))"
   proof -
     assume fsafe:"fsafe (Prop p args)"
       and ssafe:"ssafe σ"
     from ssafe have ssafes:"(⋀i f'. SFunctions σ i = Some f' ⟹ dfree f')"
       "(⋀f f'. SPredicates σ f = Some f' ⟹ fsafe f')"
       unfolding ssafe_def by auto
     fix ν
     note TA = Fadmit_Prop1.hyps(1)
       and some = Fadmit_Prop1.hyps(2) and NFA = Fadmit_Prop1.hyps(3)
     from fsafe have safes:"⋀i. dsafe (args i)" using dfree_is_dsafe by auto
     have IH:"(⋀ν'. ⋀i. dsafe (args i) ⟹
         dterm_sem I (Tsubst (args i) σ) ν = dterm_sem (adjoint I σ ν) (args i) ν)" 
       using  subst_dterm[OF good_interp TA safes ssafes] by auto
     have eqs:"⋀i ν'. dterm_sem I (Tsubst (args i) σ) ν = dterm_sem (adjoint I σ ν) (args i) ν"
       by (auto simp add: IH safes)
     let ?sub = "(λ i. Tsubst (args i) σ)"
     have subSafe:"(∀ i. dsafe (?sub i))"
       by (simp add: safes ssafes tsubst_preserves_safe)
     have freef:"fsafe p'" using ssafe some unfolding ssafe_def by auto 
     have IH2:"(ν ∈ fml_sem I (FsubstFO p' ?sub)) = (ν ∈ fml_sem (adjointFO I ?sub ν) p')"
       by (simp add: nsubst_fml [OF good_interp NFA freef subSafe])
     have vec:"(χ i. dterm_sem I (Tsubst (args i) σ) ν) = (χ i. dterm_sem (local.adjoint I σ ν) (args i) ν)"
       apply(auto simp add: vec_eq_iff)
       subgoal for i
         using IH[of i, OF safes[of i]] 
         by auto
       done
     show "?thesis ν" 
       using IH safes eqs apply (auto simp add:  IH2  some good_interp)
       using some unfolding adjoint_def adjointFO_def by auto
   qed    
next
  case (Fadmit_Context1 σ φ C C') then
  have FA:"Fadmit σ φ"
    and FUA:"FUadmit σ φ UNIV"
    and some:"SContexts σ C = Some C'"
    and PFA:"PFadmit (λ_. Fsubst φ σ) C'"
    and IH:"fsafe φ ⟹ ssafe σ ⟹ (⋀ν. (ν ∈ fml_sem I (Fsubst φ σ)) = (ν ∈ fml_sem (local.adjoint I σ ν) φ))"
    and substSafe:"fsafe(Fsubst φ σ)"
    by auto
  have "fsafe (InContext C φ) ⟹ ssafe σ ⟹ (⋀ν. (ν ∈ fml_sem I (Fsubst (InContext C φ) σ)) = (ν ∈ fml_sem (local.adjoint I σ ν) (InContext C φ)))"
  proof -
    assume safe:"fsafe (InContext C φ)"
    from safe have fsafe:"fsafe φ" by (auto dest: fsafe.cases)
    assume ssafe:"ssafe σ"
    fix ν :: "'sz state"
    have agree:"⋀ω. Vagree ν ω (-UNIV)" unfolding Vagree_def by auto
    have adj_eq:"⋀ω. fml_sem (adjoint I σ ν) φ = fml_sem (adjoint I σ ω) φ"
      using uadmit_fml_adjoint[OF FUA agree fsafe ssafe good_interp] by auto
    have eq:"(ν ∈ fml_sem I (Fsubst φ σ)) = (ν ∈ fml_sem (local.adjoint I σ ν) φ)"
      using adj_eq IH[OF fsafe ssafe] by auto
    let ?sub = "(λ_. Fsubst φ σ)"
    let ?R1 = "fml_sem I (Fsubst φ σ)"
    let ?R2 = "fml_sem (adjoint I σ ν) φ"
    have eq':"?R1 = ?R2"
      using adj_eq IH[OF fsafe ssafe] by auto
    have freef:"fsafe C'" using ssafe some unfolding ssafe_def by auto 
    have IH2:"(ν ∈ fml_sem I (PFsubst C' ?sub)) = (ν ∈ fml_sem (PFadjoint I ?sub) C')"
      using psubst_fml good_interp PFA fsafe substSafe freef by blast 
    have IH':"(⋀ν. (ν ∈ fml_sem I (Fsubst φ σ)) = (ν ∈ fml_sem (adjoint I σ ν) φ))"
      using IH[OF fsafe ssafe] by auto
    then have IH:"fml_sem I (Fsubst φ σ) = fml_sem (adjoint I σ ν) φ"
      using eq' by blast
    have duh:" (λf' _. fml_sem I (case () of () ⇒ Fsubst φ σ)) = (λ x (). fml_sem (local.adjoint I σ ν) φ)"
      by (simp add: case_unit_Unity eq' ext)
    have extend_PF:"(PFadjoint I ?sub) = (extendc I ?R2)"
      unfolding PFadjoint_def using IH apply (simp)
      by (metis old.unit.case old.unit.exhaust)
    have "(ν ∈ fml_sem I (Fsubst (InContext C φ) σ)) = (ν ∈ fml_sem I (PFsubst C' (λ_. Fsubst φ σ)))"
      using some by simp
    moreover have "... = (ν ∈ fml_sem (PFadjoint I ?sub) C')"
      using IH2 by auto
    moreover have "... = (ν ∈ fml_sem (extendc I ?R2) C')"
      using extend_PF by simp
    moreover have "... = (ν ∈ fml_sem (extendc I ?R1) C')"
      using eq' by auto
    moreover have "... = (ν ∈ Contexts (adjoint I σ ν) C (fml_sem (adjoint I σ ν) φ))"
      using some unfolding adjoint_def apply auto
      apply (simp add: eq' local.adjoint_def)
      by (simp add: eq' local.adjoint_def)
    moreover have "... = (ν ∈ fml_sem (adjoint I σ ν) (InContext C φ))"
      by auto
    ultimately
    show "(ν ∈ fml_sem I (Fsubst (InContext C φ) σ)) = (ν ∈ fml_sem (local.adjoint I σ ν) (InContext C φ))"
      by blast
  qed
  then show ?case by auto
next
  case (Fadmit_Context2 σ φ C) then
  have FA:"Fadmit σ φ"
  and FUA:"FUadmit σ φ UNIV"
  and none:"SContexts σ C = None"
  and IH:"fsafe φ ⟹ ssafe σ ⟹ (⋀ν. (ν ∈ fml_sem I (Fsubst φ σ)) = (ν ∈ fml_sem (local.adjoint I σ ν) φ))"
    by auto
  have "fsafe (InContext C φ) ⟹
           ssafe σ ⟹ (⋀ν. (ν ∈ fml_sem I (Fsubst (InContext C φ) σ)) = (ν ∈ fml_sem (local.adjoint I σ ν) (InContext C φ)))"
  proof -
    assume safe:"fsafe (InContext C φ)"
    then have fsafe:"fsafe φ" by (auto dest: fsafe.cases)
    assume ssafe:"ssafe σ"
    fix ν
    have Ieq:" Contexts (local.adjoint I σ ν) C = Contexts I C"
      using none unfolding adjoint_def by auto
    have IH':"⋀ν. (ν ∈ fml_sem I (Fsubst φ σ)) = (ν ∈ fml_sem (local.adjoint I σ ν) φ)"
      using IH[OF fsafe ssafe] by auto
    have agree:"⋀ω. Vagree ν ω (-UNIV)" unfolding Vagree_def by auto
    have adj_eq:"⋀ω. fml_sem (adjoint I σ ν) φ = fml_sem (adjoint I σ ω) φ"
      using uadmit_fml_adjoint[OF FUA agree fsafe ssafe good_interp] by auto
    then have sem:"fml_sem I (Fsubst φ σ) =  fml_sem (local.adjoint I σ ν) φ"
      using IH' agree adj_eq by auto
    show "?thesis ν"  using none Ieq sem by auto
  qed
  then show ?case by auto
qed

lemma subst_fml:
  fixes I::"('sf, 'sc, 'sz) interp" and ν::"'sz state"
  assumes good_interp:"is_interp I"
  assumes Fadmit:"Fadmit σ φ"
  assumes fsafe:"fsafe φ"
  assumes ssafe:"ssafe σ"
  shows "(ν ∈ fml_sem I (Fsubst φ σ)) = (ν ∈ fml_sem (adjoint I σ ν) φ)"
      using subst_fml_hp[OF good_interp] Fadmit fsafe ssafe by blast
    
lemma subst_fml_valid:
  fixes I::"('sf, 'sc, 'sz) interp" and ν::"'sz state"
  assumes Fadmit:"Fadmit σ φ"
  assumes fsafe:"fsafe φ"
  assumes ssafe:"ssafe σ"
  assumes valid:"valid φ"
  shows "valid (Fsubst φ σ)"
proof -
  have sub_sem:"⋀I ν. is_interp I ⟹ ν ∈ fml_sem I (Fsubst φ σ)"
  proof -
    fix I::"('sf,'sc,'sz) interp" and ν::"'sz state"
    assume good_interp:"is_interp I"
    have good_adj:"is_interp (adjoint I σ ν)"
      apply(rule adjoint_safe[OF good_interp])
      using ssafe unfolding ssafe_def by auto
    have φsem:"ν ∈ fml_sem (adjoint I σ ν) φ" using valid using good_adj unfolding valid_def by blast
    then show "?thesis I ν"
      using subst_fml[OF good_interp Fadmit fsafe ssafe]
      by auto
  qed
  then show ?thesis unfolding valid_def by blast 
qed
  

lemma subst_sequent:
  fixes I::"('sf, 'sc, 'sz) interp" and ν::"'sz state"
  assumes good_interp:"is_interp I"
  assumes Sadmit:"Sadmit σ (Γ,Δ)"
  assumes Ssafe:"Ssafe (Γ,Δ)"
  assumes ssafe:"ssafe σ"
  shows "(ν ∈ seq_sem I (Ssubst (Γ,Δ) σ)) = (ν ∈ seq_sem (adjoint I σ ν) (Γ,Δ))"
proof -
  let ?f = "(seq2fml (Γ, Δ))"
  have subst_eqG:"Fsubst (foldr (&&) Γ TT) σ = foldr (&&) (map (λφ. Fsubst φ σ) Γ) TT"
    by(induction Γ, auto simp add: TT_def)
  have subst_eqD:"Fsubst (foldr (||) Δ FF) σ = foldr (||) (map (λφ. Fsubst φ σ) Δ) FF"
    by(induction Δ, auto simp add: FF_def Or_def)
  have subst_eq:"Fsubst ?f σ = (seq2fml (Ssubst (Γ, Δ) σ))"
    using subst_eqG subst_eqD 
    by (auto simp add: Implies_def Or_def)
  have fsafeG:"fsafe (foldr (&&) Γ TT)" 
    using Ssafe apply(induction Γ, auto simp add: Ssafe_def TT_def)
    by fastforce
  have fsafeD:"fsafe (foldr (||) Δ FF)" 
    using Ssafe Or_def apply(induction Δ, auto simp add: Ssafe_def FF_def Or_def)
    by fastforce
  have fsafe:"fsafe ?f" 
    using fsafeD fsafeG by (auto simp add: Implies_def Or_def)
  have FadmitG:"Fadmit σ (foldr (&&) Γ TT)"
    using Sadmit Or_def apply(induction Γ, auto simp add: Sadmit_def TT_def Or_def)
    by fastforce
  have FadmitD:"Fadmit σ (foldr (||) Δ FF)"
    using Sadmit Or_def apply(induction Δ, auto simp add: Sadmit_def FF_def Or_def)
    by fastforce
  have Fadmit:"Fadmit σ ?f" 
    using FadmitG FadmitD unfolding Implies_def
    by (simp add: Implies_def Or_def)
  have "(ν ∈ fml_sem I (Fsubst ?f σ)) 
       =(ν ∈ fml_sem (adjoint I σ ν) (seq2fml (Γ, Δ)))"
    using subst_fml[OF good_interp Fadmit fsafe ssafe]
    by auto
  then show ?thesis
    using subst_eq by auto
  qed

subsection ‹Soundness of substitution rule›
theorem subst_rule:
  assumes sound:"sound R"
  assumes Radmit:"Radmit σ R"
  assumes FVS:"FVS σ = {}"
  assumes Rsafe:"Rsafe R"
  assumes ssafe:"ssafe σ"
  shows "sound (Rsubst R σ)"
proof -
  obtain SG and C where Rdef:"R = (SG,C)" by (cases R, auto)
  obtain SG' and C' where Rdef':"Rsubst R σ = (SG',C')" by (cases R, auto)
  obtain ΓC and ΔC where Cdef:"C = (ΓC, ΔC)" by (cases C, auto)
  obtain ΓC' and ΔC' where C'def:"C' = (ΓC', ΔC')" by (cases C', auto)
  have CC':"(Ssubst (ΓC, ΔC) σ) = (ΓC', ΔC')"
    using Rdef Rdef' Cdef C'def by auto
  have "⋀I ν. is_interp I ⟹ (⋀Γ Δ ω  . List.member SG' (Γ, Δ) ⟹ ω ∈ seq_sem I (Γ, Δ)) ⟹ ν ∈ seq_sem I C'"
  proof -
    fix I::"('sf,'sc,'sz) interp" and ν::"'sz state"
    assume good_interp:"is_interp I"
    assume prems:"(⋀Γ Δ ω. List.member SG' (Γ, Δ) ⟹ ω ∈ seq_sem I (Γ, Δ))"
    have good_interp':"⋀ω. is_interp (adjoint I σ ω)"
      using adjoint_safe[OF good_interp ] ssafe[unfolded ssafe_def] by auto
    have sound:"⋀ω. (⋀φ ν . List.member SG φ ⟹ ν ∈ seq_sem (adjoint I σ ω) φ) ⟹ ω ∈ seq_sem (adjoint I σ ω) (ΓC, ΔC)"
      using soundD_memv[of SG C] sound good_interp' Rdef Cdef by auto
    have SadmitC:"Sadmit σ (ΓC, ΔC)" 
      using Radmit unfolding Radmit_def Rdef Cdef by auto
    have SsafeC:"Ssafe (ΓC, ΔC)" 
      using Rsafe unfolding Rsafe_def Rdef Cdef by auto
    have seq_sem:"ν ∈ seq_sem (adjoint I σ ν) (ΓC, ΔC)"
    proof(rule sound)
      fix S :: "('sf,'sc,'sz) sequent" and ν'
      assume mem:"List.member SG S"
      obtain ΓS ΔS where Sdef:"S = (ΓS, ΔS)" by (cases S, auto)
      from mem obtain di where di:"di < length SG ∧ SG ! di = S"
      by (meson in_set_conv_nth in_set_member)
      have SadmitS:"Sadmit σ (ΓS, ΔS)"
        using Rdef Sdef di Radmit Radmit_def by auto
      have SsafeS:"Ssafe (ΓS, ΔS)"
        using Rsafe unfolding Rsafe_def Rdef Cdef using Sdef mem di by auto
      have map_mem:"⋀f L x. List.member L x ⟹ List.member (map f L) (f x)"
        subgoal for f L x 
          by (induction L, auto simp add: member_rec)
        done
      let ?S' = "(Ssubst (ΓS, ΔS) σ)"
      have eq:"Ssubst S σ = (map (λφ. Fsubst φ σ) ΓS, map (λφ. Fsubst φ σ) ΔS)" 
        using Sdef by auto
      from Sdef have mem':"List.member SG' (fst ?S', snd ?S')"
        using mem Rdef Rdef' eq map_mem[of SG S "(λx. Ssubst x σ)"] by auto
      have "ν' ∈ seq_sem I (fst ?S', snd ?S')" by (rule prems[OF mem', of ν'])
      then have "ν' ∈ seq_sem (adjoint I σ ν') S"
        using subst_sequent[OF good_interp SadmitS SsafeS ssafe, of ν']
        Sdef by auto
      have VA:"Vagree ν ν' (FVS σ)" using FVS unfolding Vagree_def by auto
      show "ν' ∈ seq_sem (local.adjoint I σ ν) S"
        using adjoint_consequence VA ssafe[unfolded ssafe_def]
        by (metis ‹ν' ∈ seq_sem (local.adjoint I σ ν') S› dfree_is_dsafe)
      qed
    have "ν ∈ seq_sem I (ΓC', ΔC')"
      using subst_sequent[OF good_interp SadmitC SsafeC ssafe, of ν] seq_sem Cdef C'def CC'
      by auto
    then show  "ν ∈ seq_sem I C'" using C'def by auto
    qed
  then show ?thesis
    apply(rule soundI_memv')
      using Rdef' by auto
qed

end end

Theory Uniform_Renaming

theory "Uniform_Renaming" 
imports
  Ordinary_Differential_Equations.ODE_Analysis
  "Ids"
  "Lib"
  "Syntax"
  "Denotational_Semantics"
  "Frechet_Correctness"
  "Static_Semantics"
  "Coincidence"
  "Bound_Effect"
begin context ids begin

section ‹Uniform and Bound Renaming›
text ‹Definitions and soundness proofs for the renaming rules Uniform Renaming and Bound Renaming.
Renaming in dL swaps the names of two variables x and y, as in the swap operator of Nominal Logic.
›
fun swap ::"'sz ⇒ 'sz ⇒ 'sz ⇒ 'sz"
where "swap x y z = (if z = x then  y else if z = y then x else z)"
 
subsection ‹Uniform Renaming Definitions›

primrec TUrename :: "'sz ⇒ 'sz ⇒ ('sf, 'sz) trm ⇒ ('sf, 'sz) trm"
where 
  "TUrename x y (Var z) = Var (swap x y z)"
| "TUrename x y (DiffVar z) = DiffVar (swap x y z)"
| "TUrename x y (Const r) = (Const r)"
| "TUrename x y (Function f args) = Function f (λi. TUrename x y (args i))"
| "TUrename x y (Plus θ1 θ2) = Plus (TUrename x y θ1) (TUrename x y θ2)"
| "TUrename x y (Times θ1 θ2) = Times (TUrename x y θ1) (TUrename x y θ2)"
| "TUrename x y (Differential θ) = Differential (TUrename x y θ)"
  
primrec OUrename :: "'sz ⇒ 'sz ⇒ ('sf, 'sz) ODE ⇒ ('sf, 'sz) ODE"
where
  "OUrename x y (OVar c) = undefined"
| "OUrename x y (OSing z θ) = OSing (swap x y z) (TUrename x y θ)"
| "OUrename x y (OProd ODE1 ODE2) = OProd (OUrename x y ODE1) (OUrename x y ODE2)"
  
inductive ORadmit :: "('sf, 'sz) ODE ⇒ bool"
where
  ORadmit_Sing:"ORadmit (OSing x θ)"
| ORadmit_Prod:"ORadmit ODE1 ⟹ ORadmit ODE2 ⟹ ORadmit (OProd ODE1 ODE2)"
  
primrec PUrename :: "'sz ⇒ 'sz ⇒ ('sf, 'sc, 'sz) hp ⇒ ('sf, 'sc, 'sz) hp"
  and   FUrename :: "'sz ⇒ 'sz ⇒ ('sf, 'sc, 'sz) formula ⇒ ('sf, 'sc, 'sz) formula"
where
  "PUrename x y (Pvar a) = undefined"
| "PUrename x y (Assign z θ) = Assign (swap x y z) (TUrename x y θ)"
| "PUrename x y (DiffAssign z θ) = DiffAssign (swap x y z) (TUrename x y θ)"
| "PUrename x y (Test φ) = Test (FUrename x y φ)"
| "PUrename x y (EvolveODE ODE φ) = EvolveODE (OUrename x y ODE) (FUrename x y φ)"
| "PUrename x y (Choice a b) = Choice (PUrename x y a) (PUrename x y b)"
| "PUrename x y (Sequence a b) = Sequence (PUrename x y a) (PUrename x y b)"
| "PUrename x y (Loop a) = Loop (PUrename x y a)"

| "FUrename x y (Geq θ1 θ2) = Geq (TUrename x y θ1) (TUrename x y θ2)"
| "FUrename x y (Prop p args) = Prop p (λi. TUrename x y (args i))"
| "FUrename x y (Not φ) = Not (FUrename x y φ)"
| "FUrename x y (And φ ψ) = And (FUrename x y φ) (FUrename x y ψ)"
| "FUrename x y (Exists z φ) = Exists (swap x y z) (FUrename x y φ)"
| "FUrename x y (Diamond α φ) = Diamond (PUrename x y α) (FUrename x y φ)"
| "FUrename x y (InContext C φ) = undefined"

subsection ‹Uniform Renaming Admissibility›

inductive PRadmit :: "('sf, 'sc, 'sz) hp ⇒ bool"
  and     FRadmit ::"('sf, 'sc, 'sz) formula ⇒ bool"
where
  PRadmit_Assign:"PRadmit (Assign x θ)"
| PRadmit_DiffAssign:"PRadmit (DiffAssign x θ)"
| PRadmit_Test:"FRadmit φ ⟹ PRadmit (Test φ)"
| PRadmit_EvolveODE:"ORadmit ODE ⟹ FRadmit φ ⟹ PRadmit (EvolveODE ODE φ)"
| PRadmit_Choice:"PRadmit a ⟹ PRadmit b ⟹ PRadmit (Choice a b)"
| PRadmit_Sequence:"PRadmit a ⟹ PRadmit b ⟹ PRadmit (Sequence a b)"
| PRadmit_Loop:"PRadmit a ⟹ PRadmit (Loop a)"

| FRadmit_Geq:"FRadmit (Geq θ1 θ2)"
| FRadmit_Prop:"FRadmit (Prop p args)"
| FRadmit_Not:"FRadmit φ ⟹ FRadmit (Not φ)"
| FRadmit_And:"FRadmit φ ⟹ FRadmit ψ ⟹ FRadmit (And φ ψ)"
| FRadmit_Exists:"FRadmit φ ⟹ FRadmit (Exists x φ)"
| FRadmit_Diamond:"PRadmit α ⟹ FRadmit φ ⟹ FRadmit (Diamond α φ)"

inductive_simps
    FRadmit_box_simps[simp]: "FRadmit (Box a f)"
and PRadmit_box_simps[simp]: "PRadmit (Assign x e)"

definition RSadj :: "'sz ⇒ 'sz ⇒ 'sz simple_state ⇒ 'sz simple_state"
where "RSadj x y ν = (χ z. ν $ (swap x y z))" 

definition Radj :: "'sz ⇒ 'sz ⇒ 'sz state ⇒ 'sz state"
where "Radj x y ν = (RSadj x y (fst ν), RSadj x y (snd ν))" 

lemma SUren: "sterm_sem I (TUrename x y θ) ν = sterm_sem I θ (RSadj x y ν)"
  by (induction θ, auto simp add: RSadj_def)

lemma ren_preserves_dfree:"dfree θ ⟹ dfree (TUrename x y θ)"
  by(induction rule: dfree.induct, auto intro: dfree.intros)

subsection ‹Uniform Renaming Soundness Proof and Lemmas›

lemma TUren_frechet:
  assumes good_interp:"is_interp I"
  shows "dfree θ ⟹ frechet I (TUrename x y θ) ν ν' = frechet I θ (RSadj x y ν) (RSadj x y ν')"
proof (induction rule: dfree.induct)
  ― ‹There's got to be a more elegant proof of this...›
  case (dfree_Var i)
  then show ?case 
    unfolding RSadj_def apply auto 
       subgoal by (metis vec_lambda_eta)
      subgoal
      proof (auto simp add: axis_def)
        assume yx:"y ≠ x"
        have a:"(χ z. ν' $ (if z = x then y else if z = y then x else z)) $ y = ν' $ x"
         by simp
       show "ν' ∙ (χ i. if i = x then 1 else 0) 
                 = (χ z. ν' $ (if z = x then y else if z = y then x else z)) ∙ (χ i. if i = y then 1 else 0)"
         by (metis (no_types) a axis_def inner_axis)
      qed
     subgoal
     proof -
       have "⋀v s. v ∙ (χ sa. if sa = (s::'sz) then 1 else 0) = v $ s"
         subgoal for v s
           using inner_axis[of v s 1]
           by (auto simp add: axis_def)
         done
       then show ?thesis
         by (auto simp add: axis_def)
     qed
    subgoal
    proof -
      assume a1: "i ≠ y"
      assume a2: "i ≠ x"
      have "⋀v s. v ∙ (χ sa. if sa = (s::'sz) then 1 else 0) = v $ s"
        by (metis (no_types) inner_axis axis_def inner_prod_eq)
      then show ?thesis
        using a2 a1 by (auto simp add: axis_def)
    qed
    done 
qed (auto simp add: SUren good_interp is_interp_def)

lemma RSadj_fst:"RSadj x y (fst ν) = fst (Radj x y ν)"
  unfolding RSadj_def Radj_def by auto

lemma RSadj_snd:"RSadj x y (snd ν) = snd (Radj x y ν)"
  unfolding RSadj_def Radj_def by auto

lemma TUren:
  assumes good_interp:"is_interp I"
  shows "dsafe θ ⟹ dterm_sem I (TUrename x y θ) ν = dterm_sem I θ (Radj x y ν)"
proof (induction rule: dsafe.induct)
  case (dsafe_Diff θ)
  assume free:"dfree θ"
  show ?case 
    apply (auto simp add: directional_derivative_def)
    using TUren_frechet[OF good_interp free, of x y "fst ν" "snd ν"]
     by (auto simp add: RSadj_fst RSadj_snd)
qed (auto simp add: Radj_def RSadj_def)

lemma adj_sum:"RSadj x y (ν1 + ν2) = (RSadj x y ν1) + (RSadj x y ν2)"
  unfolding RSadj_def apply auto apply (rule vec_extensionality)
  subgoal for i
    apply (cases "i = x")
     apply (cases "i = y")
      by auto
  done

lemma OUren: "ORadmit ODE ⟹ ODE_sem I (OUrename x y ODE) ν = RSadj x y (ODE_sem I ODE (RSadj x y ν))"
proof (induction rule: ORadmit.induct)
  case (ORadmit_Prod ODE1 ODE2)
  then show ?case 
    using adj_sum by auto
next
  case (ORadmit_Sing z θ)
  then show ?case 
    by (rule vec_extensionality | auto simp add: SUren RSadj_def)+   
qed

lemma state_eq: 
  fixes ν ν' :: "'sz state"
  shows "(⋀i. (fst ν) $ i = (fst ν') $ i) ⟹ (⋀i. (snd ν) $ i = (snd ν') $ i) ⟹ ν  = ν'"
  apply (cases "ν", cases "ν'", auto)
   by(rule vec_extensionality, auto)+
  
lemma Radj_repv1:
  fixes x y z ::"'sz" 
  shows "(Radj x y (repv ν y r)) = repv (Radj x y ν) x r"
  apply(rule state_eq)
   subgoal for i
     apply(cases "i = x") apply (cases "i = y") 
       unfolding Radj_def RSadj_def by auto
  subgoal for i
    apply(cases "i = x") apply (cases "i = y") 
      unfolding Radj_def RSadj_def by auto
  done

lemma Radj_repv2:
  fixes x y z ::"'sz" 
  shows "(Radj x y (repv ν x r)) = repv (Radj x y ν) y r"
  apply(rule state_eq)
   subgoal for i
     apply(cases "i = x") apply (cases "i = y") 
       unfolding Radj_def RSadj_def by auto
  subgoal for i
    apply(cases "i = x") apply (cases "i = y") 
      unfolding Radj_def RSadj_def by auto
  done

lemma Radj_repv3:
  fixes x y z ::"'sz" 
  assumes zx:"z ≠ x" and zy:"z ≠ y"
  shows "(Radj x y (repv ν z r)) = repv (Radj x y ν) z r"
  apply(rule state_eq)
   subgoal for i
     apply(cases "i = x") apply (cases "i = y") 
       using zx zy unfolding Radj_def RSadj_def by auto
  subgoal for i
    apply(cases "i = x") apply (cases "i = y") 
      using zx zy unfolding Radj_def RSadj_def by auto
  done

lemma Radj_repd1:
  fixes x y z ::"'sz" 
  shows "(Radj x y (repd ν y r)) = repd (Radj x y ν) x r"
  apply(rule state_eq)
   subgoal for i
     apply(cases "i = x") apply (cases "i = y") 
       unfolding Radj_def RSadj_def by auto
  subgoal for i
    apply(cases "i = x") apply (cases "i = y") 
      unfolding Radj_def RSadj_def by auto
  done

lemma Radj_repd2:
  fixes x y z ::"'sz" 
  shows "(Radj x y (repd ν x r)) = repd (Radj x y ν) y r"
  apply(rule state_eq)
   subgoal for i
     apply(cases "i = x") apply (cases "i = y") 
       unfolding Radj_def RSadj_def by auto
  subgoal for i
    apply(cases "i = x") apply (cases "i = y") 
      unfolding Radj_def RSadj_def by auto
  done

lemma Radj_repd3:
  fixes x y z ::"'sz" 
  assumes zx:"z ≠ x" and zy:"z ≠ y"
  shows "(Radj x y (repd ν z r)) = repd (Radj x y ν) z r"
  apply(rule state_eq)
   subgoal for i
     apply(cases "i = x") apply (cases "i = y")
     using zx zy unfolding Radj_def RSadj_def by auto
  subgoal for i
    apply(cases "i = x") apply (cases "i = y") 
    using zx zy unfolding Radj_def RSadj_def by auto
  done

― ‹i.e. shows ‹Radj x y› is a bijection for all ‹x y››
lemma Radj_eq_iff:"(a = b) = ((Radj x y a) = (Radj x y b))"
  unfolding Radj_def RSadj_def apply auto
  apply (rule state_eq)
   apply smt+
  done

lemma RSadj_cancel:"RSadj x y (RSadj x y ν) = ν"
  unfolding RSadj_def apply auto
  apply(rule vec_extensionality)
  by(auto)

lemma Radj_cancel:"Radj x y (Radj x y ν) = ν"
  unfolding Radj_def RSadj_def apply auto
  apply(rule state_eq)
   subgoal for i by(cases "i = x", cases "i = y", auto)
  subgoal for i by(cases "i = x", cases "i = y", auto)
  done

lemma OUrename_preserves_ODE_vars:"ORadmit ODE ⟹ {z. (swap x y z) ∈ ODE_vars I ODE} = ODE_vars I (OUrename x y ODE)"
  apply(induction rule: ORadmit.induct)
   subgoal for xa θ by auto
  subgoal for ODE1 ODE2
  proof -
    assume IH1:"{z. swap x y z ∈ ODE_vars I ODE1} = ODE_vars I (OUrename x y ODE1)"
    assume IH2:"{z. swap x y z ∈ ODE_vars I ODE2} = ODE_vars I (OUrename x y ODE2)"
    have "{z. swap x y z ∈ ODE_vars I (OProd ODE1 ODE2)} =
          {z. swap x y z ∈ (ODE_vars I ODE1 ∪ ODE_vars I ODE2)}" by auto
    moreover have "... = {z. swap x y z ∈ (ODE_vars I ODE1)} ∪ {z. swap x y z ∈ (ODE_vars I ODE2)}" by auto
    moreover have "... = ODE_vars I (OUrename x y ODE1) ∪ ODE_vars I (OUrename x y ODE2)" using IH1 IH2 by auto
    moreover have "... = ODE_vars I (OUrename x y (OProd ODE1 ODE2))" by auto
    ultimately show "{z. swap x y z ∈ ODE_vars I (OProd ODE1 ODE2)} = ODE_vars I (OUrename x y (OProd ODE1 ODE2))"
      by blast
  qed
  done

lemma ren_proj:"(RSadj x y a) $ z = a $ (swap x y z)"
  unfolding RSadj_def by simp

lemma swap_cancel:"swap x y (swap x y z) = z"
  by auto

lemma mkv_lemma:
  assumes ORA:"ORadmit ODE"
  shows "Radj x y (mk_v I (OUrename x y ODE) (a, b) c) = mk_v I ODE (RSadj x y a, RSadj x y b) (RSadj x y c)"
proof -
  have inner1:"(mk_v I (OUrename x y ODE) (a, b) c) = ((χ i. (if i ∈ ODE_vars I (OUrename x y ODE) then c else a) $ i), (χ i. (if i ∈ ODE_vars I (OUrename x y ODE) then ODE_sem I (OUrename x y ODE) c else b) $ i))"
    using mk_v_concrete[of I "OUrename x y ODE" "(a,b)" c] by auto
  have inner2:"(((χ i. (if i ∈ ODE_vars I (OUrename x y ODE) then c else a) $ i), (χ i. (if i ∈ ODE_vars I (OUrename x y ODE) then ODE_sem I (OUrename x y ODE) c else b) $ i))) 
            = (((χ i. (if (swap x y i) ∈ ODE_vars I ODE then c else a) $ i), (χ i. (if (swap x y i) ∈ ODE_vars I ODE then ODE_sem I (OUrename x y ODE) c else b) $ i)))"
    by (force simp: OUrename_preserves_ODE_vars[OF ORA, symmetric])
  have "Radj x y (mk_v I (OUrename x y ODE) (a, b) c) = 
        Radj x y (((χ i. (if i ∈ ODE_vars I (OUrename x y ODE) then c else a) $ i), (χ i. (if i ∈ ODE_vars I (OUrename x y ODE) then ODE_sem I (OUrename x y ODE) c else b) $ i)))"
    using inner1 by auto
  moreover have "... = Radj x y (((χ i. (if (swap x y i) ∈ ODE_vars I ODE then c else a) $ i), 
                              (χ i. (if (swap x y i) ∈ ODE_vars I ODE then ODE_sem I (OUrename x y ODE) c else b) $ i)))"
    using inner2 by auto
  moreover have "... = (((χ i. (if (swap x y (swap x y i)) ∈ ODE_vars I ODE then c else a) $ (swap x y i))),
                         (χ i. (if (swap x y (swap x y i)) ∈ ODE_vars I ODE then ODE_sem I (OUrename x y ODE) c else b) $ (swap x y i)))"
    unfolding Radj_def RSadj_def by auto
  moreover have "... = (((χ i. (if i ∈ ODE_vars I ODE then c else a) $ (swap x y i))),
                         (χ i. (if i ∈ ODE_vars I ODE then ODE_sem I (OUrename x y ODE) c else b) $ (swap x y i)))"
    using swap_cancel by auto
  moreover have "... = (((χ i. (if i ∈ ODE_vars I ODE then RSadj x y c else RSadj x y a) $ i)),
                         (χ i. (if i ∈ ODE_vars I ODE then RSadj x y (ODE_sem I (OUrename x y ODE) c) else RSadj x y b) $ i))"
     by(auto simp add: ren_proj)
  moreover have "... = (((χ i. (if i ∈ ODE_vars I ODE then RSadj x y c else RSadj x y a) $ i)),
                         (χ i. (if i ∈ ODE_vars I ODE then RSadj x y (RSadj x y (ODE_sem I ODE (RSadj x y c))) else RSadj x y b) $ i))"
    using OUren[OF ORA, of I x y c] by auto
  moreover have "... = (((χ i. (if i ∈ ODE_vars I ODE then RSadj x y c else RSadj x y a) $ i)),
                         (χ i. (if i ∈ ODE_vars I ODE then (ODE_sem I ODE (RSadj x y c)) else RSadj x y b) $ i))"
    by(auto simp add: RSadj_cancel)
  moreover have "... = mk_v I ODE (RSadj x y a, RSadj x y b) (RSadj x y c)"
    using mk_v_concrete[of I "ODE" "(RSadj x y a, RSadj x y b)" "RSadj x y c"]
    by auto
  ultimately show ?thesis by auto
qed

lemma sol_lemma:
  assumes ORA:"ORadmit ODE"
  assumes t:"0 ≤ t"
  assumes fml:"⋀ν. (ν ∈ fml_sem I (FUrename x y φ)) = (Radj x y ν ∈ fml_sem I φ)"
  assumes sol:"(sol solves_ode (λa. ODE_sem I (OUrename x y ODE))) {0..t} {xa. mk_v I (OUrename x y ODE) (sol 0, b) xa ∈ fml_sem I (FUrename x y φ)}"
  shows "((λt. RSadj x y (sol t)) solves_ode (λa. ODE_sem I ODE)) {0..t} {xa. mk_v I ODE (RSadj x y (sol 0), RSadj x y b) xa ∈ fml_sem I φ}"
  apply(unfold solves_ode_def)
  apply(rule conjI)
   defer
   subgoal 
     apply auto
   proof -
     fix s
     assume t:"0 ≤ s" "s ≤ t"
     have ivl:"s ∈ {0..t}" using t by auto
     have "mk_v I (OUrename x y ODE) (sol 0,b) (sol s) ∈ fml_sem I (FUrename x y φ)"
       using solves_odeD(2)[OF sol ivl] by auto
     then have "Radj x y (mk_v I (OUrename x y ODE) (sol 0, b) (sol s)) ∈ fml_sem I φ"
       using fml[of "mk_v I (OUrename x y ODE) (sol 0, b) (sol s)"] by auto
     then show "mk_v I ODE (RSadj x y (sol 0), RSadj x y b) (RSadj x y (sol s)) ∈ fml_sem I φ"
         using mkv_lemma[OF ORA, of x y I "sol 0" b "sol s"] by auto
   qed
   apply (unfold has_vderiv_on_def has_vector_derivative_def)
   proof -
     have "⋀s. s∈{0..t} ⟹  ((λt. RSadj x y (sol t)) has_derivative (λxb. xb *⇩_R ODE_sem I ODE (RSadj x y (sol s)))) (at s within {0..t})"
     proof -
       fix s
       assume s:"s ∈{0..t}"
       let ?g = "RSadj x y"
       let ?g' = "RSadj x y"
       let ?f = "sol"
       let ?f' = "(λt'. t' *⇩_R ODE_sem I (OUrename x y ODE) (sol s))"
       let ?h = "?g ∘ ?f"
       
       have fun_eq:"(λt'. t' *⇩_R ODE_sem I (OUrename x y ODE) (sol s)) = (λt'. t' *⇩_R (RSadj x y (ODE_sem I ODE (RSadj x y (sol s)))))"
         apply(rule ext)
         using OUren[OF ORA, of I x y] by simp
       have fun_eq1:"(λν. (χ i. RSadj x y ν $ i)) = RSadj x y"
         by(rule ext, rule vec_extensionality, simp)
       have "s ∈ {0..t} ⟹ (sol has_derivative (λt'. t' *⇩_R ODE_sem I (OUrename x y ODE) (sol s))) (at s within {0..t})"
         using solves_odeD(1)[OF sol] unfolding has_vderiv_on_def has_vector_derivative_def by auto
       then have fderiv:"s ∈ {0..t} ⟹ (?f has_derivative ?f') (at s within {0..t})"
         using fun_eq by auto
       have "((λν. (χ i. RSadj x y ν $ i)) has_derivative (λν'. (χ i . RSadj x y ν' $ i))) (at (?f s) within ?f ` {0..t})"
         apply(rule has_derivative_vec)
         apply(auto simp add: RSadj_def intro:derivative_eq_intros)
           by (simp add: has_derivative_at_withinI has_derivative_proj')+
       then have gderiv:"(RSadj x y has_derivative (RSadj x y)) (at (?f s) within ?f ` {0..t})"
         using fun_eq1 by auto
       have hderiv:"(?h has_derivative (?g' ∘ ?f')) (at s within {0..t})"
         by (rule diff_chain_within[OF fderiv gderiv], rule s)
       have heq:"(λt. RSadj x y (sol t)) = ?h"
         unfolding comp_def by simp
       have RSadj_scale:"⋀c a. RSadj x y (c *⇩_R RSadj x y a) = c *⇩_R a"
         subgoal for c a
           unfolding RSadj_def
           apply auto
           apply(rule vec_extensionality)
           by(auto)
         done
       have heq':"(λxb. xb *⇩_R ODE_sem I ODE (RSadj x y (sol s))) = (?g' ∘ ?f')"
         unfolding comp_def apply(rule ext) using OUren[OF ORA, of I x y "sol s"]
         apply auto
         subgoal for c
           using RSadj_scale[of c "ODE_sem I ODE (RSadj x y (sol s))"] by auto            
         done
       show "((λt. RSadj x y (sol t)) has_derivative (λxb. xb *⇩_R ODE_sem I ODE (RSadj x y (sol s)))) (at s within {0..t})"
         using heq heq' hderiv by auto 
       qed
    then show "∀xa∈{0..t}. ((λt. RSadj x y (sol t)) has_derivative (λxb. xb *⇩_R ODE_sem I ODE (RSadj x y (sol xa)))) (at xa within {0..t})"
      by auto
    qed

lemma sol_lemma2:
  assumes ORA:"ORadmit ODE"
  assumes t:"0 ≤ t"
  assumes fml:"⋀ν. (ν ∈ fml_sem I (FUrename x y φ)) = (Radj x y ν ∈ fml_sem I φ)"
  assumes sol:"(sol solves_ode (λa. ODE_sem I ODE)) {0..t} {x. mk_v I ODE (sol 0, b) x ∈ fml_sem I φ}"
  shows "((λt. RSadj x y (sol t)) solves_ode (λa. ODE_sem I (OUrename x y ODE))) {0..t} 
          {xa. mk_v I (OUrename x y ODE) (RSadj x y (sol 0), RSadj x y b) xa ∈ fml_sem I (FUrename x y φ)}"
  apply(unfold solves_ode_def)
  apply(rule conjI)
   defer
   subgoal 
     apply auto
   proof -
     fix s
     assume t:"0 ≤ s" "s ≤ t"
     have ivl:"s ∈ {0..t}" using t by auto
     have "mk_v I ODE (sol 0,b) (sol s) ∈ fml_sem I φ"
       using solves_odeD(2)[OF sol ivl] by auto
     then have "Radj x y (mk_v I ODE (sol 0, b) (sol s)) ∈ fml_sem I (FUrename x y φ)"
       using Radj_cancel[of x y "(mk_v I ODE (sol 0, b) (sol s))"]
       by (simp add: fml)
     then show " mk_v I (OUrename x y ODE) (RSadj x y (sol 0), RSadj x y b) (RSadj x y (sol s)) ∈ fml_sem I (FUrename x y φ)"
         using mkv_lemma[OF ORA, of x y I "RSadj x y (sol 0)" "RSadj x y b" "RSadj x y (sol s)"]
         by (simp add: RSadj_cancel ‹mk_v I ODE (sol 0, b) (sol s) ∈ fml_sem I φ› fml)
   qed
   apply (unfold has_vderiv_on_def has_vector_derivative_def)
 proof -
   have "⋀s. s∈{0..t} ⟹  ((λt. RSadj x y (sol t)) has_derivative (λxb. xb *⇩_R ODE_sem I (OUrename x y ODE) (RSadj x y (sol s)))) (at s within {0..t})"
   proof -
     fix s
     assume s:"s ∈{0..t}"
     let ?g = "RSadj x y"
     let ?g' = "RSadj x y"
     let ?f = "sol"
     let ?f' = "(λxb. xb *⇩_R RSadj x y (ODE_sem I (OUrename x y ODE) (RSadj x y (sol s))))"
     let ?h = "?g ∘ ?f"
     have fun_eq:"(λt'. t' *⇩_R ODE_sem I ODE (sol s)) = (λxb. xb *⇩_R RSadj x y (ODE_sem I (OUrename x y ODE) (RSadj x y (sol s))))"
       apply(rule ext)
       using OUren[OF ORA, of I x y, of "RSadj x y (sol s)"] RSadj_cancel by simp
     have fun_eq1:"(λν. (χ i. RSadj x y ν $ i)) = RSadj x y"
       by(rule ext, rule vec_extensionality, simp)
     have "s ∈ {0..t} ⟹ (sol has_derivative (λt'. t' *⇩_R ODE_sem I ODE (sol s))) (at s within {0..t})"
       using solves_odeD(1)[OF sol] unfolding has_vderiv_on_def has_vector_derivative_def by auto
     then have fderiv:"s ∈ {0..t} ⟹ (?f has_derivative ?f') (at s within {0..t})"
       using fun_eq by auto
     have "((λν. (χ i. RSadj x y ν $ i)) has_derivative (λν'. (χ i . RSadj x y ν' $ i))) (at (?f s) within ?f ` {0..t})"
       apply(rule has_derivative_vec)
       apply(auto simp add: RSadj_def intro:derivative_eq_intros)
         by (simp add: has_derivative_at_withinI has_derivative_proj')+
     then have gderiv:"(RSadj x y has_derivative (RSadj x y)) (at (?f s) within ?f ` {0..t})"
       using fun_eq1 by auto
     have hderiv:"(?h has_derivative (?g' ∘ ?f')) (at s within {0..t})"
       by (rule diff_chain_within[OF fderiv gderiv], rule s)
     have heq:"(λt. RSadj x y (sol t)) = ?h"
       unfolding comp_def by simp
     have RSadj_scale:"⋀c a. RSadj x y (c *⇩_R RSadj x y a) = c *⇩_R a"
       subgoal for c a
         unfolding RSadj_def
         apply auto
         apply(rule vec_extensionality)
         by(auto)
       done
     have heq':"(λxb. xb *⇩_R ODE_sem I (OUrename x y ODE) (RSadj x y (sol s))) = (?g' ∘ ?f')"
       unfolding comp_def apply(rule ext) using OUren[OF ORA, of I x y "RSadj x y (sol s)"]
       apply auto
       subgoal for c
         using RSadj_scale[of c "ODE_sem I (OUrename x y ODE) (RSadj x y (sol s))"] RSadj_cancel[of x y "sol s"]
             RSadj_cancel[of x y "ODE_sem I ODE (sol s)"] by auto
       done
     show "((λt. RSadj x y (sol t)) has_derivative (λxb. xb *⇩_R ODE_sem I (OUrename x y ODE) (RSadj x y (sol s)))) (at s within {0..t})"
       using heq heq' hderiv by auto 
       qed
  then show "∀xa∈{0..t}. ((λt. RSadj x y (sol t)) has_derivative (λxb. xb *⇩_R ODE_sem I (OUrename x y ODE) (RSadj x y (sol xa)))) (at xa within {0..t})"
  by blast
qed
    
lemma PUren_FUren:
  assumes good_interp:"is_interp I"
  shows
    "(PRadmit α ⟶ hpsafe α ⟶ (∀ ν ω. (ν, ω) ∈ prog_sem I (PUrename x y α) ⟷ (Radj x y ν, Radj x y ω) ∈ prog_sem I α))
    ∧ (FRadmit φ ⟶ fsafe φ ⟶ (∀ ν. ν ∈ fml_sem I (FUrename x y φ) ⟷ (Radj x y ν) ∈ fml_sem I φ))"
proof(induction rule: PRadmit_FRadmit.induct)
  case (FRadmit_Geq θ1 θ2)
  then show ?case using TUren[OF good_interp] by auto
next
  case (FRadmit_Exists φ z) then have
    FRA:"FRadmit φ"
    and IH:"fsafe φ ⟹  (⋀ν. (ν ∈ fml_sem I (FUrename x y φ)) = (Radj x y ν ∈ fml_sem I φ))"
    by auto
  have "fsafe (Exists z φ) ⟹  (⋀ν. (ν ∈ fml_sem I (FUrename x y (Exists z φ))) = (Radj x y ν ∈ fml_sem I (Exists z φ)))"
    apply (cases "z = x")
     subgoal for ν
     proof -
       assume fsafe:"fsafe (Exists z φ)"
       assume zx:"z = x"
       from fsafe have fsafe':"fsafe φ" by auto
       have IH':"(⋀ν. (ν ∈ fml_sem I (FUrename x y φ)) = (Radj x y ν ∈ fml_sem I φ))"
         by (rule IH[OF fsafe'])
       have "(ν ∈ fml_sem I (FUrename x y (Exists z φ))) = (ν ∈ fml_sem I (Exists y (FUrename x y φ)))" using zx by auto
       moreover have "... = (∃r. (repv ν y r) ∈ fml_sem I (FUrename x y φ))" by auto
       moreover have "... = (∃r. (Radj x y (repv ν y r)) ∈ fml_sem I φ)" using IH' by auto
       moreover have "... = (∃r. (repv (Radj x y ν) x r) ∈ fml_sem I φ)" using Radj_repv1[of x y ν] by auto
       moreover have "... = (Radj x y ν ∈ fml_sem I (Exists z φ))" using zx by auto
       ultimately 
       show "(ν ∈ fml_sem I (FUrename x y (Exists z φ))) = (Radj x y ν ∈ fml_sem I (Exists z φ))"
         by auto
     qed
    apply (cases "z = y")
     subgoal for ν
     proof -
       assume fsafe:"fsafe (Exists z φ)"
       assume zx:"z = y"
       from fsafe have fsafe':"fsafe φ" by auto
       have IH':"(⋀ν. (ν ∈ fml_sem I (FUrename x y φ)) = (Radj x y ν ∈ fml_sem I φ))"
         by (rule IH[OF fsafe'])
       have "(ν ∈ fml_sem I (FUrename x y (Exists z φ))) = (ν ∈ fml_sem I (Exists x (FUrename x y φ)))" using zx by auto
       moreover have "... = (∃r. (repv ν x r) ∈ fml_sem I (FUrename x y φ))" by auto
       moreover have "... = (∃r. (Radj x y (repv ν x r)) ∈ fml_sem I φ)" using IH' by auto
       moreover have "... = (∃r. (repv (Radj x y ν) y r) ∈ fml_sem I φ)" using Radj_repv2[of x y ν] by auto
       moreover have "... = (Radj x y ν ∈ fml_sem I (Exists z φ))" using zx by auto
       ultimately 
       show "(ν ∈ fml_sem I (FUrename x y (Exists z φ))) = (Radj x y ν ∈ fml_sem I (Exists z φ))"
         by auto
     qed
    subgoal for ν
    proof -
      assume fsafe:"fsafe (Exists z φ)"
      assume zx:"z ≠ x" and zy:"z ≠ y"
      from fsafe have fsafe':"fsafe φ" by auto
      have IH':"(⋀ν. (ν ∈ fml_sem I (FUrename x y φ)) = (Radj x y ν ∈ fml_sem I φ))"
        by (rule IH[OF fsafe'])
      have "(ν ∈ fml_sem I (FUrename x y (Exists z φ))) = (ν ∈ fml_sem I (Exists z (FUrename x y φ)))" using zx zy by auto
      moreover have "... = (∃r. (repv ν z r) ∈ fml_sem I (FUrename x y φ))" by auto
      moreover have "... = (∃r. (Radj x y (repv ν z r)) ∈ fml_sem I φ)" using IH' by auto
      moreover have "... = (∃r. (repv (Radj x y ν) z r) ∈ fml_sem I φ)" using Radj_repv3[of z x y ν, OF zx zy] by auto
      moreover have "... = (Radj x y ν ∈ fml_sem I (Exists z φ))" using zx by auto
      ultimately 
      show "(ν ∈ fml_sem I (FUrename x y (Exists z φ))) = (Radj x y ν ∈ fml_sem I (Exists z φ))"
        by auto
    qed
    done
  then show ?case by auto 
next
  case (PRadmit_Assign z θ)
  have "hpsafe (Assign z θ) ⟹  (⋀ν ω. ((ν, ω)  ∈ prog_sem I (PUrename x y (Assign z θ))) = ((Radj x y ν, Radj x y ω) ∈ prog_sem I (Assign z θ)))"
    apply (cases "z = x")
     subgoal for ν ω
     proof -
       assume fsafe:"hpsafe (Assign z θ)"
       assume zx:"z = x"
       from fsafe have dsafe:"dsafe θ" by auto
       have IH':"(⋀ν. dterm_sem I (TUrename x y θ) ν = dterm_sem I θ (Radj x y ν))"
         subgoal for ν using TUren[OF good_interp dsafe , of x y ν] by auto done
       have "((ν, ω) ∈ prog_sem I (PUrename x y (Assign z θ))) = ((ν, ω) ∈ prog_sem I (Assign y (TUrename x y θ)))"  using zx by auto
       moreover have "... = (ω = repv ν y (dterm_sem I (TUrename x y θ) ν))" by auto
       moreover have "... = (ω = repv ν y (dterm_sem I θ (Radj x y ν)))" using IH' by auto
       moreover have "... = (Radj x y ω = Radj x y (repv ν y (dterm_sem I θ (Radj x y ν))))" using Radj_eq_iff by auto
       moreover have "... = (Radj x y ω = repv (Radj x y ν) x (dterm_sem I θ (Radj x y ν)))" using Radj_repv1 by auto
       moreover have "... = (Radj x y ω = repv (Radj x y ν) z (dterm_sem I θ (Radj x y ν)))" using zx by auto
       moreover have "... = ((Radj x y ν, Radj x y ω) ∈ prog_sem  I (Assign z θ))" by auto        
       ultimately 
       show "((ν, ω) ∈ prog_sem I (PUrename x y (Assign z θ))) = ((Radj x y ν, Radj x y ω) ∈ prog_sem  I (Assign z θ))"
         by auto
     qed
    apply (cases "z = y")
     subgoal for ν ω
     proof -
       assume fsafe:"hpsafe (Assign z θ)"
       assume zy:"z = y"
       from fsafe have dsafe:"dsafe θ" by auto
       have IH':"(⋀ν. dterm_sem I (TUrename x y θ) ν = dterm_sem I θ (Radj x y ν))"
         subgoal for ν using TUren[OF good_interp dsafe , of x y ν] by auto done
       have "((ν, ω) ∈ prog_sem I (PUrename x y (Assign z θ))) = ((ν, ω) ∈ prog_sem I (Assign x (TUrename x y θ)))"  using zy by auto
       moreover have "... = (ω = repv ν x (dterm_sem I (TUrename x y θ) ν))" by auto
       moreover have "... = (ω = repv ν x (dterm_sem I θ (Radj x y ν)))" using IH' by auto
       moreover have "... = (Radj x y ω = Radj x y (repv ν x (dterm_sem I θ (Radj x y ν))))" using Radj_eq_iff by auto
       moreover have "... = (Radj x y ω = repv (Radj x y ν) y (dterm_sem I θ (Radj x y ν)))" using Radj_repv2 by auto
       moreover have "... = (Radj x y ω = repv (Radj x y ν) z (dterm_sem I θ (Radj x y ν)))" using zy by auto
       moreover have "... = ((Radj x y ν, Radj x y ω) ∈ prog_sem  I (Assign z θ))" by auto        
       ultimately 
       show "((ν, ω) ∈ prog_sem I (PUrename x y (Assign z θ))) = ((Radj x y ν, Radj x y ω) ∈ prog_sem  I (Assign z θ))"
         by auto
     qed
    subgoal for ν ω
    proof -
      assume fsafe:"hpsafe (Assign z θ)"
      assume zx:"z ≠ x" and zy:"z ≠ y"
      from fsafe have dsafe:"dsafe θ" by auto
      have IH':"(⋀ν. dterm_sem I (TUrename x y θ) ν = dterm_sem I θ (Radj x y ν))"
        subgoal for ν using TUren[OF good_interp dsafe , of x y ν] by auto done
      have "((ν, ω) ∈ prog_sem I (PUrename x y (Assign z θ))) = ((ν, ω) ∈ prog_sem I (Assign z (TUrename x y θ)))"  using zx zy by auto
      moreover have "... = (ω = repv ν z (dterm_sem I (TUrename x y θ) ν))" by auto
      moreover have "... = (ω = repv ν z (dterm_sem I θ (Radj x y ν)))" using IH' by auto
      moreover have "... = (Radj x y ω = Radj x y (repv ν z (dterm_sem I θ (Radj x y ν))))" using Radj_eq_iff by auto
      moreover have "... = (Radj x y ω = repv (Radj x y ν) z (dterm_sem I θ (Radj x y ν)))" using Radj_repv3[OF zx zy] by auto
      moreover have "... = ((Radj x y ν, Radj x y ω) ∈ prog_sem  I (Assign z θ))" by auto        
      ultimately 
      show "((ν, ω) ∈ prog_sem I (PUrename x y (Assign z θ))) = ((Radj x y ν, Radj x y ω) ∈ prog_sem  I (Assign z θ))"
        by auto
    qed
    done
  then show ?case by auto
next
  case (PRadmit_DiffAssign z θ)
  have "hpsafe (DiffAssign z θ) ⟹  (⋀ν ω. ((ν, ω)  ∈ prog_sem I (PUrename x y (DiffAssign z θ))) = ((Radj x y ν, Radj x y ω) ∈ prog_sem I (DiffAssign z θ)))"
    apply (cases "z = x")
     subgoal for ν ω
     proof -
       assume fsafe:"hpsafe (DiffAssign z θ)"
       assume zx:"z = x"
       from fsafe have dsafe:"dsafe θ" by auto
       have IH':"(⋀ν. dterm_sem I (TUrename x y θ) ν = dterm_sem I θ (Radj x y ν))"
         subgoal for ν using TUren[OF good_interp dsafe , of x y ν] by auto done
       have "((ν, ω) ∈ prog_sem I (PUrename x y (DiffAssign z θ))) = ((ν, ω) ∈ prog_sem I (DiffAssign y (TUrename x y θ)))"  using zx by auto
       moreover have "... = (ω = repd ν y (dterm_sem I (TUrename x y θ) ν))" by auto
       moreover have "... = (ω = repd ν y (dterm_sem I θ (Radj x y ν)))" using IH' by auto
       moreover have "... = (Radj x y ω = Radj x y (repd ν y (dterm_sem I θ (Radj x y ν))))" using Radj_eq_iff by auto
       moreover have "... = (Radj x y ω = repd (Radj x y ν) x (dterm_sem I θ (Radj x y ν)))" using Radj_repd1 by auto
       moreover have "... = (Radj x y ω = repd (Radj x y ν) z (dterm_sem I θ (Radj x y ν)))" using zx by auto
       moreover have "... = ((Radj x y ν, Radj x y ω) ∈ prog_sem  I (DiffAssign z θ))" by auto        
       ultimately 
       show "((ν, ω) ∈ prog_sem I (PUrename x y (DiffAssign z θ))) = ((Radj x y ν, Radj x y ω) ∈ prog_sem  I (DiffAssign z θ))"
         by auto
     qed
    apply (cases "z = y")
     subgoal for ν ω
     proof -
       assume fsafe:"hpsafe (DiffAssign z θ)"
       assume zy:"z = y"
       from fsafe have dsafe:"dsafe θ" by auto
       have IH':"(⋀ν. dterm_sem I (TUrename x y θ) ν = dterm_sem I θ (Radj x y ν))"
         subgoal for ν using TUren[OF good_interp dsafe , of x y ν] by auto done
       have "((ν, ω) ∈ prog_sem I (PUrename x y (DiffAssign z θ))) = ((ν, ω) ∈ prog_sem I (DiffAssign x (TUrename x y θ)))"  using zy by auto
       moreover have "... = (ω = repd ν x (dterm_sem I (TUrename x y θ) ν))" by auto
       moreover have "... = (ω = repd ν x (dterm_sem I θ (Radj x y ν)))" using IH' by auto
       moreover have "... = (Radj x y ω = Radj x y (repd ν x (dterm_sem I θ (Radj x y ν))))" using Radj_eq_iff by auto
       moreover have "... = (Radj x y ω = repd (Radj x y ν) y (dterm_sem I θ (Radj x y ν)))" using Radj_repd2 by auto
       moreover have "... = (Radj x y ω = repd (Radj x y ν) z (dterm_sem I θ (Radj x y ν)))" using zy by auto
       moreover have "... = ((Radj x y ν, Radj x y ω) ∈ prog_sem  I (DiffAssign z θ))" by auto        
       ultimately 
        show "((ν, ω) ∈ prog_sem I (PUrename x y (DiffAssign z θ))) = ((Radj x y ν, Radj x y ω) ∈ prog_sem  I (DiffAssign z θ))"
         by auto
     qed
    subgoal for ν ω
  proof -
    assume fsafe:"hpsafe (DiffAssign z θ)"
    assume zx:"z ≠ x" and zy:"z ≠ y"
    from fsafe have dsafe:"dsafe θ" by auto
    have IH':"(⋀ν. dterm_sem I (TUrename x y θ) ν = dterm_sem I θ (Radj x y ν))"
      subgoal for ν using TUren[OF good_interp dsafe , of x y ν] by auto done
    have "((ν, ω) ∈ prog_sem I (PUrename x y (DiffAssign z θ))) = ((ν, ω) ∈ prog_sem I (DiffAssign z (TUrename x y θ)))"  using zx zy by auto
    moreover have "... = (ω = repd ν z (dterm_sem I (TUrename x y θ) ν))" by auto
    moreover have "... = (ω = repd ν z (dterm_sem I θ (Radj x y ν)))" using IH' by auto
    moreover have "... = (Radj x y ω = Radj x y (repd ν z (dterm_sem I θ (Radj x y ν))))" using Radj_eq_iff by auto
    moreover have "... = (Radj x y ω = repd (Radj x y ν) z (dterm_sem I θ (Radj x y ν)))" using Radj_repd3[OF zx zy] by auto
    moreover have "... = ((Radj x y ν, Radj x y ω) ∈ prog_sem  I (DiffAssign z θ))" by auto        
    ultimately 
    show "((ν, ω) ∈ prog_sem I (PUrename x y (DiffAssign z θ))) = ((Radj x y ν, Radj x y ω) ∈ prog_sem  I (DiffAssign z θ))"
      by auto
  qed
  done
  then show ?case by auto
next
  case (PRadmit_Test φ) then
  have FRA:"FRadmit φ"
  and IH:"fsafe φ ⟹ (⋀ν. (ν ∈ fml_sem I (FUrename x y φ)) = (Radj x y ν ∈ fml_sem I φ))"
    by auto
  have "hpsafe (? φ) ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (PUrename x y (? φ))) = ((Radj x y ν, Radj x y ω) ∈ prog_sem I (? φ)))"
    proof -
      assume hpsafe:"hpsafe (? φ)"
      fix ν ω
      from hpsafe have fsafe:"fsafe φ" by auto
      have IH':"⋀ν. (ν ∈ fml_sem I (FUrename x y φ)) = (Radj x y ν ∈ fml_sem I φ)" 
        by (rule IH[OF fsafe])
      have "((ν, ω) ∈ prog_sem I (PUrename x y (? φ))) = (ν = ω ∧ (ω ∈ fml_sem I (FUrename x y φ)))" by (cases ω, auto)
      moreover have "... = (ν = ω ∧ (Radj x y ω) ∈ fml_sem I φ)" using IH' by auto
      moreover have "... = (Radj x y ν = Radj x y ω ∧ (Radj x y ω) ∈ fml_sem I φ)" using Radj_eq_iff by auto
      moreover have "... = ((Radj x y ν, Radj x y ω) ∈ prog_sem I (? φ))" by (cases "Radj x y ω", auto)
      ultimately show "?thesis ν ω" by auto
    qed
  then show ?case by auto
next
  case (FRadmit_Prop p args) then
  have "fsafe (Prop p args) ⟹ (⋀ν. (ν ∈ fml_sem I (FUrename x y (Prop p args))) = ((Radj x y ν) ∈ fml_sem I (Prop p args)))"
  proof -
    assume fsafe:"fsafe (Prop p args)"
    fix ν
    from fsafe have dsafes:"⋀i. dsafe (args i)" using dfree_is_dsafe by auto
    have IH:"⋀i ν. dterm_sem I (TUrename x y (args i)) ν = dterm_sem I (args i) (Radj x y ν)"
      using TUren[OF good_interp dsafes] by auto
    have "(ν ∈ fml_sem I (FUrename x y (Prop p args))) = (ν ∈ fml_sem I (Prop p (λi . TUrename x y (args i))))" by auto
    moreover have "... = (Predicates I p (χ i. dterm_sem I (TUrename x y (args i)) ν))" by auto
    moreover have "... = (Predicates I p (χ i. dterm_sem I (args i) (Radj x y ν)))" using IH by auto
    moreover have "... = ((Radj x y ν) ∈ fml_sem I (Prop p args))" by auto
    ultimately show "?thesis ν" by blast
  qed 
  then show ?case by auto
next
  case (PRadmit_Sequence a b) then 
  have IH1:"hpsafe a ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (PUrename x y a)) = ((Radj x y ν, Radj x y ω) ∈ prog_sem I a))"
    and  IH2:"hpsafe b ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (PUrename x y b)) = ((Radj x y ν, Radj x y ω) ∈ prog_sem I b))"
    by auto
  have "hpsafe (a ;; b) ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (PUrename x y (a ;;b))) = ((Radj x y ν, Radj x y ω) ∈ prog_sem I (a ;; b)))"
  proof -
    assume hpsafe:"hpsafe (a ;; b)"
    fix ν ω
    from hpsafe have safe1:"hpsafe a" and safe2:"hpsafe b" by auto
    have IH1:"(⋀μ. ((ν, μ) ∈ prog_sem I (PUrename x y a)) = ((Radj x y ν, Radj x y μ) ∈ prog_sem I a))"
      using IH1[OF safe1] by auto
    have IH2:"(⋀μ. ((μ, ω) ∈ prog_sem I (PUrename x y b)) = ((Radj x y μ, Radj x y ω) ∈ prog_sem I b))"
      using IH2[OF safe2] by auto
    have "((ν, ω) ∈ prog_sem I (PUrename x y (a ;;b))) = ((ν, ω) ∈ prog_sem I ((PUrename x y a) ;;(PUrename x y b)))" by auto
    moreover have "... = (∃μ. (ν, μ) ∈ prog_sem I (PUrename x y a) ∧ (μ, ω) ∈ prog_sem I (PUrename x y b))" by auto
    moreover have "... = (∃μ. (Radj x y ν, Radj x y μ) ∈ prog_sem I a ∧ (Radj x y μ, Radj x y ω) ∈ prog_sem I b)" using IH1 IH2 by auto
    moreover have "... = (∃μ. (Radj x y ν, μ) ∈ prog_sem I a ∧ (μ, Radj x y ω) ∈ prog_sem I b)" 
      apply auto
       subgoal for aa ba
         apply(rule exI[where x="fst(Radj x y (aa,ba))"])
         apply(rule exI[where x="snd(Radj x y (aa,ba))"])
         by auto
      subgoal for aa ba
        apply(rule exI[where x="fst(Radj x y (aa,ba))"])
        apply(rule exI[where x="snd(Radj x y (aa,ba))"])
        using Radj_cancel by auto
      done
    moreover have "... = ((Radj x y ν, Radj x y ω) ∈ prog_sem I (a ;;b))" by (auto,blast)
    ultimately show "?thesis ν ω" by auto
  qed
  then show ?case by auto
next
  case (FRadmit_Diamond α φ) then
  have IH1:"hpsafe α ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (PUrename x y α)) = ((Radj x y ν, Radj x y ω) ∈ prog_sem I α))"
  and IH2:"fsafe φ ⟹ (⋀ν. (ν ∈ fml_sem I (FUrename x y φ)) = (Radj x y ν ∈ fml_sem I φ))"
    by auto
  have "fsafe (⟨α⟩φ) ⟹ (⋀ν. (ν ∈ fml_sem I (FUrename x y (⟨α⟩φ))) = (Radj x y ν ∈ fml_sem I (⟨α⟩φ)))"
  proof -
    assume safe:"fsafe (⟨α⟩φ)"
    fix ν
    from safe have safe1:"hpsafe α" and safe2:"fsafe φ" by auto
    have IH1:"⋀ω. ((ν, ω) ∈ prog_sem I (PUrename x y α)) = ((Radj x y ν, Radj x y ω) ∈ prog_sem I α)"
      using IH1[OF safe1] by auto
    have IH2:"⋀ν. (ν ∈ fml_sem I (FUrename x y φ)) = (Radj x y ν ∈ fml_sem I φ)"
      by (rule IH2[OF safe2])
    have "(ν ∈ fml_sem I (FUrename x y (⟨α⟩φ))) = (ν ∈ fml_sem I (⟨PUrename x y α⟩FUrename x y φ))" by auto
    moreover have "... = (∃ ω. (ν, ω) ∈ prog_sem I (PUrename x y α) ∧ ω ∈ fml_sem I (FUrename x y φ))" by auto
    moreover have "... = (∃ ω. (Radj x y ν, Radj x y ω) ∈ prog_sem I α ∧ (Radj x y ω) ∈ fml_sem I φ)" 
      using IH1 IH2 by auto
    moreover have "... = (∃ ω. (Radj x y ν, ω) ∈ prog_sem I α ∧ ω ∈ fml_sem I φ)"
      apply auto
       subgoal for aa ba
         apply(rule exI[where x="fst(Radj x y (aa,ba))"])
         apply(rule exI[where x="snd(Radj x y (aa,ba))"])
         by auto
      subgoal for aa ba
        apply(rule exI[where x="fst(Radj x y (aa,ba))"])
        apply(rule exI[where x="snd(Radj x y (aa,ba))"])
        using Radj_cancel by auto
      done
    moreover have "... = (Radj x y ν ∈ fml_sem I (⟨α⟩φ))" by auto
    ultimately show "?thesis ν" by auto
  qed
  then show ?case by auto
next
  case (PRadmit_Loop a) then
  have IH:" hpsafe a ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (PUrename x y a)) = ((Radj x y ν, Radj x y ω) ∈ prog_sem I a))"
    by auto
  have "hpsafe (a** ) ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (PUrename x y (a** ))) = ((Radj x y ν, Radj x y ω) ∈ prog_sem I (a** )))"
  proof -
    assume safe:"hpsafe (a** )"
    fix ν ω
    from safe have safe:"hpsafe a" by auto
    have IH1:"(⋀ν ω. ((ν, ω) ∈ prog_sem I (PUrename x y a)) = ((Radj x y ν, Radj x y ω) ∈ prog_sem I a))"
      by (rule IH[OF safe])
    have relpow_iff:"⋀ν ω R n. ((ν, ω) ∈ R ^^ Suc n) = (∃μ. (ν, μ) ∈ R ∧ (μ, ω) ∈ R ^^ n)"
      apply auto
       subgoal for R n x y z by (auto simp add: relpow_Suc_D2')
      subgoal for ν ω R n μ using relpow_Suc_I2 by fastforce
      done
    have rtrancl_iff_relpow:"⋀ν ω R. ((ν, ω) ∈ R⇧^*) = (∃n. (ν, ω) ∈ R ^^ n)"
      using rtrancl_imp_relpow relpow_imp_rtrancl by blast
    have lem:"⋀n. (∀ ν ω.  ((ν, ω) ∈ prog_sem I (PUrename x y a)^^n) = ((Radj x y ν, Radj x y ω) ∈ prog_sem I a^^n))"
      subgoal for n
      proof(induction n)
        case 0
        then show ?case using Radj_eq_iff by auto
      next
        case (Suc n) then
        have IH2:"⋀ν ω. ((ν, ω) ∈ prog_sem I (PUrename x y a) ^^ n) = ((Radj x y ν, Radj x y ω) ∈ prog_sem I a ^^ n)"
          by auto
        have "⋀ν ω. ((ν, ω) ∈ prog_sem I (PUrename x y a) ^^ Suc n) = ((Radj x y ν, Radj x y ω) ∈ prog_sem I a ^^ Suc n)"
        proof -
          fix ν ω
          have "((ν, ω) ∈ prog_sem I (PUrename x y a) ^^ Suc n) 
            = (∃ μ. (ν, μ) ∈ prog_sem I (PUrename x y a) ∧ (μ, ω) ∈ prog_sem I (PUrename x y a) ^^ n)"
            using relpow_iff[of ν ω n "prog_sem I (PUrename x y a)"] by auto
          moreover have "... = (∃ μ. (Radj x y ν, Radj x y μ) ∈ prog_sem I a ∧ (Radj x y μ, Radj x y ω) ∈ prog_sem I a ^^ n)"
            using IH1 IH2 by blast
          moreover have "... = (∃ μ. (Radj x y ν, μ) ∈ prog_sem I a ∧ (μ, Radj x y ω) ∈ prog_sem I a ^^ n)"
            apply auto
             subgoal for aa ba
               apply(rule exI[where x="fst(Radj x y (aa,ba))"])
               apply(rule exI[where x="snd(Radj x y (aa,ba))"])
               by auto
            subgoal for aa ba
              apply(rule exI[where x="fst(Radj x y (aa,ba))"])
              apply(rule exI[where x="snd(Radj x y (aa,ba))"])
              using Radj_cancel by auto
            done
          moreover have "... = ((Radj x y ν, Radj x y ω) ∈ prog_sem I a ^^ Suc n)"
            using relpow_iff[of "Radj x y ν" "Radj x y ω"  n "prog_sem I a"] by auto
          ultimately show "?thesis ν ω" by auto 
        qed
        then show ?case by auto
      qed
      done
    have "((ν, ω) ∈ prog_sem I (PUrename x y (a** ))) = ((ν, ω) ∈ (prog_sem I (PUrename x y a))⇧^*)" by auto
    moreover have "... = (∃n. (ν, ω) ∈ (prog_sem I (PUrename x y a)) ^^ n)"
      using rtrancl_iff_relpow[of ν ω "prog_sem I (PUrename x y a)"] by auto
    moreover have "... = (∃n. (Radj x y ν, Radj x y ω) ∈ (prog_sem I a) ^^ n)"
      using lem by blast
    moreover have "... = ((Radj x y ν, Radj x y ω) ∈ (prog_sem I a)⇧^*)"
      using rtrancl_iff_relpow[of "Radj x y ν" "Radj x y ω" "prog_sem I a"] by auto
    moreover have "... = ((Radj x y ν, Radj x y ω) ∈ prog_sem I (a** ))" by auto
    ultimately show "?thesis ν ω" by blast
  qed
  then show ?case by auto
next
  case (PRadmit_EvolveODE ODE φ) then
  have ORA:"ORadmit ODE"
    and IH:"fsafe φ ⟹ (⋀ν. (ν ∈ fml_sem I (FUrename x y φ)) = (Radj x y ν ∈ fml_sem I φ))"
    by auto
  have "hpsafe (EvolveODE ODE φ) ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (PUrename x y (EvolveODE ODE φ))) = ((Radj x y ν, Radj x y ω) ∈ prog_sem I (EvolveODE ODE φ)))"
  proof -
    assume safe:"hpsafe (EvolveODE ODE φ)"
    fix ν ω
    from safe have osafe:"osafe ODE" and fsafe:"fsafe φ" by auto
    have IH1:"⋀ν. (ν ∈ fml_sem I (FUrename x y φ) = (Radj x y ν ∈ fml_sem I φ))" by (rule IH[OF fsafe])
    have IH2:"⋀ν. ODE_sem I (OUrename x y ODE) ν = RSadj x y (ODE_sem I ODE (RSadj x y ν))"
      using OUren[OF ORA] by auto
    have RSadj_Radj:"⋀a b. (RSadj x y a, RSadj x y b) = Radj x y (a,b)"
      unfolding RSadj_def Radj_def by auto
    have Radj_swap:"⋀a b. Radj x y a = b ⟹ a = Radj x y b"
      using Radj_cancel Radj_eq_iff by metis
    have mkv:"⋀t sol b. Radj x y (mk_v I (OUrename x y ODE) (sol 0, b) (sol t)) = mk_v I ODE (RSadj x y (sol 0), RSadj x y b) (RSadj x y (sol t))"
      using mkv_lemma[OF ORA] by blast
    have mkv2:"⋀t sol b.  Radj x y ω = mk_v I ODE (sol 0, b) (sol t) ⟹
      ω = mk_v I (OUrename x y ODE) (RSadj x y (sol 0), RSadj x y b) (RSadj x y (sol t))"
      using mkv_lemma[OF ORA] by (metis RSadj_cancel Radj_cancel)
    have sol:"⋀t sol b. 0 ≤ t ⟹
      (sol solves_ode (λa. ODE_sem I (OUrename x y ODE))) {0..t} {xa. mk_v I (OUrename x y ODE) (sol 0, b) xa ∈ fml_sem I (FUrename x y φ)} ⟹
      ((λt. RSadj x y (sol t)) solves_ode (λa. ODE_sem I ODE)) {0..t} {xa. mk_v I ODE (RSadj x y (sol 0), RSadj x y b) xa ∈ fml_sem I φ}"
      using sol_lemma IH1 IH2 ORA by blast
    have sol2:"⋀t sol b. 0 ≤ t ⟹
(sol solves_ode (λa. ODE_sem I ODE)) {0..t} {x. mk_v I ODE (sol 0, b) x ∈ fml_sem I φ} ⟹
((λt. RSadj x y (sol t)) solves_ode (λa. ODE_sem I (OUrename x y ODE))) {0..t}
 {xa. mk_v I (OUrename x y ODE) (RSadj x y (sol 0), RSadj x y b) xa ∈ fml_sem I (FUrename x y φ)}"
      using sol_lemma2 IH1 IH2 ORA by blast
    show "?thesis ν ω"
      apply auto
       subgoal for b sol t
         apply(rule exI[where x= "RSadj x y b"])
         apply(rule exI[where x= "(λt. RSadj x y (sol t))"])
         apply(rule conjI)
          subgoal using RSadj_Radj[of "sol 0" "b"] by auto
         apply(rule exI[where x =t])
         apply(rule conjI)
          subgoal by (rule mkv)
         apply(rule conjI)
          subgoal by assumption
         by (rule sol)
      subgoal for b sol t
        apply(rule exI[where x= "RSadj x y b"])
        apply(rule exI[where x= "(λt. RSadj x y (sol t))"])
        apply(rule conjI)
         subgoal using RSadj_Radj[of "sol 0" "b"] Radj_swap[of ν "(sol 0,b)"] by auto
        apply(rule exI[where x =t])
        apply(rule conjI)
         subgoal by (rule mkv2)
        apply(rule conjI)
         subgoal by assumption
        by (rule sol2)
      done
    qed
  then show ?case by auto
qed (auto simp add: Radj_def)

lemma FUren:"is_interp I ⟹ FRadmit φ ⟹ fsafe φ ⟹ (⋀ν. (ν ∈ fml_sem I (FUrename x y φ)) = (Radj x y ν ∈ fml_sem I φ))"
  using PUren_FUren by blast

subsection ‹Uniform Renaming Rule Soundness›
lemma URename_sound:"FRadmit φ ⟹ fsafe φ ⟹ valid φ ⟹ valid (FUrename x y φ)"
  unfolding valid_def using FUren by blast

subsection ‹Bound Renaming Rule Soundness›
lemma BRename_sound:
  assumes FRA:"FRadmit([[Assign x θ]]φ)"
  assumes fsafe:"fsafe ([[Assign x θ]]φ)"
  assumes valid:"valid ([[Assign x θ]]φ)"
  assumes FVF:"{Inl y, Inr y, Inr x} ∩ FVF φ = {}"
  shows "valid([[Assign y θ]]FUrename x y φ)"
proof -
  have FRA':"FRadmit φ" using FRA 
    by (metis (no_types, lifting) Box_def FRadmit.cases formula.distinct(15) formula.distinct(21) formula.distinct(27) formula.distinct(29) formula.distinct(3) formula.distinct(31) formula.distinct formula.distinct(9) formula.inject(3) formula.inject(6))
  have fsafe':"fsafe φ" using fsafe  by (simp add: Box_def)
  have dsafe:"dsafe θ" using fsafe by (simp add: Box_def)
  have "⋀I ν. is_interp I ⟹ ν ∈ fml_sem I ([[y := θ]]FUrename x y φ)"
  proof -
    fix I::"('sf,'sc,'sz) interp" and ν::"'sz state"
    assume good_interp:"is_interp I"
    from FVF have sub:"FVF φ ⊆ -{Inl y, Inr y, Inr x}" by auto
    have "Vagree (repv (Radj x y ν) x (dterm_sem I θ ν)) (repv ν x (dterm_sem I θ ν)) (-{Inl y, Inr y, Inr x})"
      unfolding Vagree_def using FVF unfolding Radj_def RSadj_def by auto
    then have agree:"Vagree (repv (Radj x y ν) x (dterm_sem I θ ν)) (repv ν x (dterm_sem I θ ν)) (FVF φ)"
      using agree_sub[OF sub] by auto
    have fml_sem_eq:"(repv (Radj x y ν) x (dterm_sem I θ ν) ∈ fml_sem I φ) = (repv ν x (dterm_sem I θ ν) ∈ fml_sem I φ)"
      using coincidence_formula[OF fsafe' Iagree_refl agree] by auto
    have "(ν ∈ fml_sem I ([[y := θ]]FUrename x y φ)) = (repv ν y (dterm_sem I θ ν) ∈ fml_sem I (FUrename x y φ))"
      by auto
    moreover have "... = (Radj x y (repv ν y (dterm_sem I θ ν)) ∈ fml_sem I φ)"
      using FUren[OF good_interp FRA' fsafe'] by auto
    moreover have "... = (repv (Radj x y ν) x (dterm_sem I θ ν) ∈ fml_sem I φ)"
      using Radj_repv1 by auto
    moreover have "... = (ν ∈ fml_sem I ([[x := θ]]φ))"
      using fml_sem_eq by auto
    moreover have "... = True"
      using valid unfolding valid_def using good_interp by blast
    ultimately
    show "ν ∈ fml_sem I ([[y := θ]]FUrename x y φ)"
      by blast
  qed
  then
  show ?thesis unfolding valid_def by auto
qed
  


end end

Theory Proof_Checker

theory "Proof_Checker" 
imports
  Ordinary_Differential_Equations.ODE_Analysis
  "Ids"
  "Lib"
  "Syntax"
  "Denotational_Semantics"
  "Axioms"
  "Differential_Axioms"
  "Frechet_Correctness"
  "Static_Semantics"
  "Coincidence"
  "Bound_Effect"
  "Uniform_Renaming"
  "USubst_Lemma"
  "Pretty_Printer"
  
begin context ids begin
section ‹Proof Checker›
text ‹This proof checker defines a datatype for proof terms in dL and a function for checking proof
 terms, with a soundness proof that any proof accepted by the checker is a proof of a sound rule or
 valid formula.

 A simple concrete hybrid system and a differential invariant rule for conjunctions are provided
 as example proofs.
›
  
lemma sound_weaken_gen:"⋀A B C. sublist A B ⟹ sound (A, C) ⟹ sound (B,C)"
proof (rule soundI_mem)
  fix A B::"('sf,'sc,'sz) sequent list" 
    and C::"('sf,'sc,'sz) sequent" 
    and I::"('sf,'sc,'sz) interp"
  assume sub:"sublist A B"
  assume good:"is_interp I"
  assume "sound (A, C)"
  then have soundC:"(⋀φ. List.member A φ ⟹ seq_sem I φ = UNIV) ⟹ seq_sem I C = UNIV"
    apply simp
    apply(drule soundD_mem)
      by (auto simp add: good)
  assume SG:"(⋀φ. List.member B φ ⟹ seq_sem I φ = UNIV)"
  show "seq_sem I C = UNIV"
    using soundC SG sub unfolding sublist_def by auto
qed
  
lemma sound_weaken:"⋀SG SGS C. sound (SGS, C) ⟹ sound (SG # SGS, C)"
  subgoal for SG SGS C
    apply(induction SGS)
     subgoal unfolding sound_def by auto
    subgoal for SG2 SGS
      unfolding sound_def 
      by (metis fst_conv le0 length_Cons not_less_eq nth_Cons_Suc snd_conv)
    done
  done

lemma member_filter:"⋀P. List.member (filter P L) x ⟹ List.member L x"
  apply(induction L, auto)
  by(metis (full_types) member_rec(1))

lemma nth_member:"n < List.length L ⟹ List.member L (List.nth L n)"
  apply(induction L, auto simp add: member_rec)
  by (metis in_set_member length_Cons nth_mem set_ConsD)

lemma mem_appL:"List.member A x ⟹ List.member (A @ B) x"
  by(induction A, auto simp add: member_rec)

lemma sound_weaken_appR:"⋀SG SGS C. sound (SG, C) ⟹ sound (SG @ SGS, C)"
  subgoal for SG SGS C
    apply(rule sound_weaken_gen)
     apply(auto)
    unfolding sublist_def apply(rule allI)
    subgoal for x
      using mem_appL[of SG x SGS] by auto 
    done
  done

fun start_proof::"('sf,'sc,'sz) sequent ⇒ ('sf,'sc,'sz) rule"
where "start_proof S = ([S], S)"
  
lemma start_proof_sound:"sound (start_proof S)"
  unfolding sound_def by auto
  
section ‹Proof Checker Implementation›

datatype axiom =
  AloopIter | AI | Atest | Abox | Achoice | AK | AV | Aassign | Adassign
| AdConst | AdPlus | AdMult
| ADW | ADE | ADC | ADS | ADIGeq | ADIGr | ADG
  
fun get_axiom:: "axiom ⇒ ('sf,'sc,'sz) formula"
where 
  "get_axiom AloopIter = loop_iterate_axiom"
| "get_axiom AI = Iaxiom"
| "get_axiom Atest = test_axiom"
| "get_axiom Abox = box_axiom"
| "get_axiom Achoice = choice_axiom"
| "get_axiom AK = Kaxiom"
| "get_axiom AV = Vaxiom"
| "get_axiom Aassign = assign_axiom"
| "get_axiom Adassign = diff_assign_axiom" 
| "get_axiom AdConst = diff_const_axiom"
| "get_axiom AdPlus = diff_plus_axiom"
| "get_axiom AdMult = diff_times_axiom"
| "get_axiom ADW = DWaxiom"
| "get_axiom ADE = DEaxiom"
| "get_axiom ADC = DCaxiom"
| "get_axiom ADS = DSaxiom"
| "get_axiom ADIGeq = DIGeqaxiom"
| "get_axiom ADIGr = DIGraxiom"
| "get_axiom ADG = DGaxiom"
  
lemma axiom_safe:"fsafe (get_axiom a)"
  by(cases a, auto simp add: axiom_defs Box_def Or_def Equiv_def Implies_def empty_def Equals_def f1_def p1_def P_def f0_def expand_singleton Forall_def Greater_def id_simps)
  (*apply(cases a)
  prefer 9
  subgoal
    apply(simp only: get_axiom.simps diff_assign_axiom_def Equiv_def Or_def Box_def)
    apply(simp only: fsafe_Not_simps fsafe_Diamond_simps fsafe_And_simps)
    apply(rule conjI)+
    subgoal apply(simp only: hpsafe_DiffAssign_simps dsafe_Fun_simps empty_def dsafe_Const) by auto
    
    *)
   (*auto simp add: loop_iterate_axiom_def Iaxiom_def diff_assign_axiom_def test_axiom_def choice_axiom_def box_axiom_def empty_def Kaxiom_def Vaxiom_def assign_axiom_def diff_const_axiom_def diff_plus_axiom_def diff_times_axiom_def DWaxiom_def Equals_def state_fun_def DEaxiom_def DCaxiom_def DSaxiom_def DIGeqaxiom_def DIGraxiom_def f1_def p1_def P_def expand_singleton f0_def Forall_def DGaxiom_def Equiv_def Implies_def Or_def Box_def Greater_def vne12*)
lemma axiom_valid:"valid (get_axiom a)"
proof (cases a)
  case AloopIter
  then show ?thesis by (simp add: loop_valid) 
next
  case AI
  then show ?thesis by (simp add: I_valid)
next
  case Atest
  then show ?thesis by (simp add: test_valid)
next
  case Abox
  then show ?thesis by (simp add: box_valid)
next
  case Achoice
  then show ?thesis by (simp add: choice_valid)
next
  case AK
  then show ?thesis by (simp add: K_valid)
next
  case AV
  then show ?thesis by (simp add: V_valid)
next
  case Aassign
  then show ?thesis by (simp add: assign_valid)
next
  case Adassign
  then show ?thesis by (simp add: diff_assign_valid)
next
  case AdConst
  then show ?thesis by (simp add: diff_const_axiom_valid)
next
  case AdPlus
  then show ?thesis by (simp add: diff_plus_axiom_valid)
next
  case AdMult
  then show ?thesis by (simp add: diff_times_axiom_valid)
next
  case ADW
  then show ?thesis by (simp add: DW_valid)
next
  case ADE
  then show ?thesis by (simp add: DE_valid)
next
  case ADC
  then show ?thesis by (simp add: DC_valid)
next
  case ADS
  then show ?thesis by (simp add: DS_valid)
next
  case ADIGeq
  then show ?thesis by (simp add: DIGeq_valid)
next
  case ADIGr
  then show ?thesis by (simp add: DIGr_valid)
next
  case ADG
  then show ?thesis by (simp add: DG_valid)
qed

datatype rrule = ImplyR | AndR | CohideR | CohideRR | TrueR | EquivR
datatype lrule = ImplyL | AndL | EquivForwardL | EquivBackwardL
  
datatype ('a, 'b, 'c) step =
  Axiom axiom
| MP
| G
| CT
| CQ  "('a, 'c) trm" "('a, 'c) trm" "('a, 'b, 'c) subst"
| CE  "('a, 'b, 'c) formula" "('a, 'b, 'c) formula" "('a, 'b, 'c) subst"
| Skolem
― ‹Apply ‹Usubst› to some other (valid) formula›
| VSubst "('a, 'b, 'c) formula" "('a, 'b, 'c) subst"
| AxSubst axiom "('a, 'b, 'c) subst"
| URename
| BRename
| Rrule rrule nat
| Lrule lrule nat
| CloseId nat nat
| Cut "('a, 'b, 'c) formula"
| DEAxiomSchema "('a,'c) ODE" "('a, 'b, 'c) subst"
  
type_synonym ('a, 'b, 'c) derivation = "(nat * ('a, 'b, 'c) step) list"
type_synonym ('a, 'b, 'c) pf = "('a,'b,'c) sequent * ('a, 'b, 'c) derivation"

fun seq_to_string :: "('sf, 'sc, 'sz) sequent ⇒ char list"
where "seq_to_string (A,S) = join '', '' (map fml_to_string A) @ '' |- '' @ join '', '' (map fml_to_string S)"
  
fun rule_to_string :: "('sf, 'sc, 'sz) rule ⇒ char list"
where "rule_to_string (SG, C) = (join '';;   '' (map seq_to_string SG)) @ ''            '' @  ⌦‹[char_of_nat 10] @› seq_to_string C"

fun close :: "'a list ⇒ 'a ⇒'a list"
where "close L x = filter (λy. y ≠ x) L"

fun closeI ::"'a list ⇒ nat ⇒'a list"
where "closeI L i = close L (nth L i)"

lemma close_sub:"sublist (close Γ φ) Γ"
  apply (auto simp add: sublist_def)
  using member_filter by fastforce

lemma close_app_comm:"close (A @ B) x  = close A x @ close B x"
  by auto

lemma close_provable_sound:"sound (SG, C) ⟹ sound (close SG φ, φ) ⟹ sound (close SG φ, C)"
proof (rule soundI_mem)
  fix I::"('sf,'sc,'sz) interp"
  assume S1:"sound (SG, C)"
  assume S2:"sound (close SG φ, φ)"
  assume good:"is_interp I"
  assume SGCs:"(⋀φ'. List.member (close SG φ) φ' ⟹ seq_sem I φ' = UNIV)"
  have Sφ:"seq_sem I φ = UNIV"
    using S2 apply simp
    apply(drule soundD_mem)
      using good apply auto
    using SGCs UNIV_I by fastforce
  have mem_close:"⋀P. List.member SG P ⟹ P ≠ φ ⟹ List.member (close SG φ) P"
    by(induction SG, auto simp add: member_rec)
  have SGs:"⋀P. List.member SG P ⟹ seq_sem I P = UNIV"
    subgoal for P
      apply(cases "P = φ")
       subgoal using Sφ by auto
      subgoal using mem_close[of P] SGCs by auto
      done
    done
  show "seq_sem I C = UNIV"
    using S1 apply simp
    apply(drule soundD_mem)
      using good apply auto
    using SGs apply auto
    using impl_sem by blast
  qed

fun Lrule_result :: "lrule ⇒ nat ⇒ ('sf, 'sc, 'sz) sequent ⇒ ('sf, 'sc, 'sz) sequent list"
where "Lrule_result AndL j (A,S) = (case (nth A j) of And p q ⇒ [(close ([p, q] @ A) (nth A j), S)])"
| "Lrule_result ImplyL j (A,S) = (case (nth A j) of Not (And (Not q) (Not (Not p))) ⇒ 
   [(close (q # A) (nth A j), S), (close A (nth A j), p # S)])"
| "Lrule_result EquivForwardL j (A,S) = (case (nth A j) of Not(And (Not (And p q)) (Not (And (Not p') (Not q')))) ⇒
   [(close (q # A) (nth A j), S), (close A (nth A j), p # S)])"
| "Lrule_result EquivBackwardL j (A,S) = (case (nth A j) of Not(And (Not (And p q)) (Not (And (Not p') (Not q')))) ⇒
   [(close (p # A) (nth A j), S), (close A (nth A j), q # S)])"

― ‹Note: Some of the pattern-matching here is... interesting. The reason for this is that we can only›
― ‹match on things in the base grammar, when we would quite like to check things in the derived grammar.›
― ‹So all the pattern-matches have the definitions expanded, sometimes in a silly way.›
fun Rrule_result :: "rrule ⇒ nat ⇒ ('sf, 'sc, 'sz) sequent ⇒ ('sf, 'sc, 'sz) sequent list"
where 
  Rstep_Imply:"Rrule_result ImplyR j (A,S) = (case (nth S j) of Not (And (Not q) (Not (Not p))) ⇒ [(p # A, q # (closeI S j))] | _ ⇒ undefined)"
| Rstep_And:"Rrule_result AndR j (A,S) = (case (nth S j) of (And p q) ⇒ [(A, p # (closeI S j )), (A, q # (closeI S j))])"
| Rstep_EquivR:"Rrule_result EquivR j (A,S) =
   (case (nth S j) of Not(And (Not (And p q)) (Not (And (Not p') (Not q')))) ⇒ 
                (if (p = p' ∧ q = q') then [(p # A, q # (closeI S j)), (q # A, p # (closeI S j))]
                else undefined))"
| Rstep_CohideR:"Rrule_result CohideR j (A,S) = [(A, [nth S j])]"
| Rstep_CohideRR:"Rrule_result CohideRR j (A,S) = [([], [nth S j])]"
| Rstep_TrueR:"Rrule_result TrueR j (A,S) = []"

fun step_result :: "('sf, 'sc, 'sz) rule ⇒ (nat * ('sf, 'sc, 'sz) step) ⇒  ('sf, 'sc, 'sz) rule"
where
  Step_axiom:"step_result (SG,C) (i,Axiom a)   = (closeI SG i, C)"
| Step_AxSubst:"step_result (SG,C) (i,AxSubst a σ)   = (closeI SG i, C)"
| Step_Lrule:"step_result (SG,C) (i,Lrule L j) = (close (append SG (Lrule_result L j (nth SG i))) (nth SG i), C)"
| Step_Rrule:"step_result (SG,C) (i,Rrule L j) = (close (append SG (Rrule_result L j (nth SG i))) (nth SG i), C)" 
| Step_Cut:"step_result (SG,C) (i,Cut φ) = (let (A,S) = nth SG i in ((φ # A, S) # ((A, φ # S) # (closeI SG i)), C))"
| Step_Vsubst:"step_result (SG,C) (i,VSubst φ σ) = (closeI SG i, C)"
| Step_CloseId:"step_result (SG,C) (i,CloseId j k) = (closeI SG i, C)"
| Step_G:"step_result (SG,C) (i,G) = (case nth SG i of (_, (Not (Diamond q (Not p))) # Nil) ⇒ (([], [p]) # closeI SG i, C))"
| Step_DEAxiomSchema:"step_result (SG,C) (i,DEAxiomSchema ODE σ) = (closeI SG i, C)"
| Step_CE:"step_result (SG,C) (i, CE φ ψ σ) =  (closeI SG i, C)"
| Step_CQ:"step_result (SG,C) (i, CQ θ⇩₁ θ⇩₂ σ) =  (closeI SG i, C)"
| Step_default:"step_result R (i,S) = R"
  
fun deriv_result :: "('sf, 'sc, 'sz) rule ⇒ ('sf, 'sc, 'sz) derivation ⇒ ('sf, 'sc, 'sz) rule"
where 
  "deriv_result R [] = R"
| "deriv_result R (s # ss) = deriv_result (step_result R s) (ss)" 
  
fun proof_result :: "('sf, 'sc, 'sz) pf ⇒ ('sf, 'sc, 'sz) rule"
where "proof_result (D,S) = deriv_result (start_proof D) S"
  
inductive lrule_ok ::"('sf,'sc,'sz) sequent list ⇒ ('sf,'sc,'sz) sequent ⇒ nat ⇒ nat ⇒ lrule ⇒ bool"
where
  Lrule_And:"⋀p q. nth (fst (nth SG i)) j = (p && q) ⟹ lrule_ok SG C i j AndL"
| Lrule_Imply:"⋀p q. nth (fst (nth SG i)) j = (p → q) ⟹ lrule_ok SG C i j ImplyL"
| Lrule_EquivForward:"⋀p q. nth (fst (nth SG i)) j = (p ↔ q) ⟹ lrule_ok SG C i j EquivForwardL"
| Lrule_EquivBackward:"⋀p q. nth (fst (nth SG i)) j = (p ↔ q) ⟹ lrule_ok SG C i j EquivBackwardL"

named_theorems prover "Simplification rules for checking validity of proof certificates" 
lemmas [prover] = axiom_defs Box_def Or_def Implies_def filter_append ssafe_def SDom_def FUadmit_def PFUadmit_def id_simps

inductive_simps 
    Lrule_And[prover]: "lrule_ok SG C i j AndL"
and Lrule_Imply[prover]: "lrule_ok SG C i j ImplyL"
and Lrule_Forward[prover]: "lrule_ok SG C i j EquivForwardL"
and Lrule_EquivBackward[prover]: "lrule_ok SG C i j EquivBackwardL"

inductive rrule_ok ::"('sf,'sc,'sz) sequent list ⇒ ('sf,'sc,'sz) sequent ⇒ nat ⇒ nat ⇒ rrule ⇒ bool"
where
  Rrule_And:"⋀p q. nth (snd (nth SG i)) j = (p && q) ⟹ rrule_ok SG C i j AndR"
| Rrule_Imply:"⋀p q. nth (snd (nth SG i)) j = (p → q) ⟹ rrule_ok SG C i j ImplyR"
| Rrule_Equiv:"⋀p q. nth (snd (nth SG i)) j = (p ↔ q) ⟹ rrule_ok SG C i j EquivR"
| Rrule_Cohide:"length (snd (nth SG i)) > j ⟹ (⋀Γ q. (nth SG i) ≠ (Γ, [q])) ⟹ rrule_ok SG C i j CohideR"
| Rrule_CohideRR:"length (snd (nth SG i)) > j  ⟹ (⋀q. (nth SG i) ≠ ([], [q])) ⟹ rrule_ok SG C i j CohideRR"
| Rrule_True:"nth (snd (nth SG i)) j = TT ⟹ rrule_ok SG C i j TrueR"
  
inductive_simps 
    Rrule_And_simps[prover]: "rrule_ok SG C i j AndR"
and Rrule_Imply_simps[prover]: "rrule_ok SG C i j ImplyR"
and Rrule_Equiv_simps[prover]: "rrule_ok SG C i j EquivR"
and Rrule_CohideR_simps[prover]: "rrule_ok SG C i j CohideR"
and Rrule_CohideRR_simps[prover]: "rrule_ok SG C i j CohideRR"
and Rrule_TrueR_simps[prover]: "rrule_ok SG C i j TrueR"

inductive step_ok  :: "('sf, 'sc, 'sz) rule ⇒ nat ⇒ ('sf, 'sc, 'sz) step ⇒ bool"
where
  Step_Axiom:"(nth SG i) = ([], [get_axiom a]) ⟹ step_ok (SG,C) i (Axiom a)"
| Step_AxSubst:"(nth SG i) = ([], [Fsubst (get_axiom a) σ]) ⟹ Fadmit σ (get_axiom a) ⟹ ssafe σ ⟹ step_ok (SG,C) i (AxSubst a σ)"
| Step_Lrule:"lrule_ok SG C i j L ⟹ j < length (fst (nth SG i)) ⟹ step_ok (SG,C) i (Lrule L j)"
| Step_Rrule:"rrule_ok SG C i j L ⟹ j < length (snd (nth SG i)) ⟹ step_ok (SG,C) i (Rrule L j)"
| Step_Cut:"fsafe φ ⟹ i < length SG ⟹ step_ok (SG,C) i (Cut φ)"
| Step_CloseId:"nth (fst (nth SG i)) j = nth (snd (nth SG i)) k ⟹ j < length (fst (nth SG i)) ⟹ k < length (snd (nth SG i)) ⟹ step_ok (SG,C) i (CloseId j k) "
| Step_G:"⋀a p. nth SG i = ([], [([[a]]p)]) ⟹ step_ok (SG,C) i G"
| Step_DEAxiom_schema:
  " nth SG i = 
  ([], [Fsubst ((([[EvolveODE (OProd (OSing vid1 (f1 fid1 vid1)) ODE) (p1 vid2 vid1)]] (P pid1)) ↔
          ([[EvolveODE ((OProd  (OSing vid1 (f1 fid1 vid1))) ODE) (p1 vid2 vid1)]]
               [[DiffAssign vid1 (f1 fid1 vid1)]]P pid1))) σ])
    ⟹ ssafe σ
    ⟹ osafe ODE
    ⟹ {Inl vid1, Inr vid1} ∩ BVO ODE = {}
    ⟹ Fadmit σ ((([[EvolveODE (OProd  (OSing vid1 (f1 fid1 vid1))ODE) (p1 vid2 vid1)]] (P pid1)) ↔
          ([[EvolveODE ((OProd  (OSing vid1 (f1 fid1 vid1))ODE)) (p1 vid2 vid1)]]
               [[DiffAssign vid1 (f1 fid1 vid1)]]P pid1))) 
    ⟹ step_ok (SG,C) i (DEAxiomSchema ODE σ)"
| Step_CE:"nth SG i = ([], [Fsubst (Equiv (InContext pid1 φ) (InContext pid1 ψ)) σ]) 
    ⟹ valid (Equiv φ ψ) 
    ⟹ fsafe φ
    ⟹ fsafe ψ
    ⟹ ssafe σ
    ⟹ Fadmit σ (Equiv (InContext pid1 φ) (InContext pid1 ψ))
    ⟹ step_ok (SG,C) i (CE φ ψ σ)"
| Step_CQ:"nth SG i = ([], [Fsubst (Equiv (Prop p (singleton θ)) (Prop p (singleton θ'))) σ]) 
    ⟹ valid (Equals θ θ') 
    ⟹ dsafe θ
    ⟹ dsafe θ'
    ⟹ ssafe σ
    ⟹ Fadmit σ (Equiv (Prop p (singleton θ)) (Prop p (singleton θ')))
    ⟹ step_ok (SG,C) i (CQ θ θ' σ)"  
  
inductive_simps 
    Step_G_simps[prover]: "step_ok (SG,C) i G"
and Step_CloseId_simps[prover]: "step_ok (SG,C) i (CloseId j k)"
and Step_Cut_simps[prover]: "step_ok (SG,C) i (Cut φ)"
and Step_Rrule_simps[prover]: "step_ok (SG,C) i (Rrule j L)"
and Step_Lrule_simps[prover]: "step_ok (SG,C) i (Lrule j L)"
and Step_Axiom_simps[prover]: "step_ok (SG,C) i (Axiom a)"
and Step_AxSubst_simps[prover]: "step_ok (SG,C) i (AxSubst a σ)"
and Step_DEAxiom_schema_simps[prover]: "step_ok (SG,C) i (DEAxiomSchema ODE σ)"
and Step_CE_simps[prover]: "step_ok (SG,C) i (CE φ ψ σ)"
and Step_CQ_simps[prover]: "step_ok (SG,C) i (CQ θ θ' σ)"

inductive deriv_ok :: "('sf, 'sc, 'sz) rule ⇒ ('sf, 'sc, 'sz) derivation ⇒ bool"
where 
  Deriv_Nil:"deriv_ok R Nil"
| Deriv_Cons:"step_ok R i S ⟹ i ≥ 0 ⟹ i < length (fst R) ⟹ deriv_ok (step_result R (i,S)) SS ⟹ deriv_ok R ((i,S) # SS)"
  
inductive_simps 
    Deriv_nil_simps[prover]: "deriv_ok R Nil"
and Deriv_cons_simps[prover]: "deriv_ok R ((i,S)#SS)"

inductive proof_ok :: "('sf, 'sc, 'sz) pf ⇒ bool"
where
  Proof_ok:"deriv_ok (start_proof D) S ⟹ proof_ok (D,S)"

inductive_simps Proof_ok_simps[prover]: "proof_ok (D,S)"

subsection ‹Soundness›

named_theorems member_intros "Prove that stuff is in lists"

lemma mem_sing[member_intros]:"⋀x. List.member [x] x"
  by(auto simp add: member_rec)

lemma mem_appR[member_intros]:"⋀A B x. List.member B x ⟹ List.member (A @ B) x"
  subgoal for A by(induction A, auto simp add: member_rec) done

lemma mem_filter[member_intros]:"⋀A P x. P x ⟹ List.member A x ⟹ List.member (filter P A) x"
  subgoal for A
    by(induction A, auto simp add: member_rec)
  done

lemma sound_weaken_appL:"⋀SG SGS C. sound (SGS, C) ⟹ sound (SG @ SGS, C)"
  subgoal for SG SGS C
    apply(rule sound_weaken_gen)
     apply(auto)
    unfolding sublist_def apply(rule allI)
    subgoal for x
      using mem_appR[of SGS x SG] by auto
    done
  done

lemma fml_seq_valid:"valid φ ⟹ seq_valid ([], [φ])"
  unfolding seq_valid_def valid_def by auto

lemma closeI_provable_sound:"⋀i. sound (SG, C) ⟹ sound (closeI SG i, (nth SG i)) ⟹ sound (closeI SG i, C)"
  using close_provable_sound by auto

lemma valid_to_sound:"seq_valid A ⟹ sound (B, A)"
  unfolding seq_valid_def sound_def by auto

lemma closeI_valid_sound:"⋀i. sound (SG, C) ⟹ seq_valid (nth SG i) ⟹ sound (closeI SG i, C)"
  using valid_to_sound closeI_provable_sound by auto
  
lemma close_nonmember_eq:"¬(List.member A a) ⟹ close A a = A"
  by (induction A, auto simp add: member_rec)

lemma close_noneq_nonempty:"List.member A x ⟹ x ≠ a ⟹ close A a ≠ []"
  by(induction A, auto simp add: member_rec)

lemma close_app_neq:"List.member A x ⟹ x ≠ a ⟹ close (A @ B) a ≠ B" 
  using append_self_conv2[of "close A a" "close B a"] append_self_conv2[of "close A a" "B"] close_app_comm[of A B a] close_noneq_nonempty[of A x a]
  apply(cases "close B a = B")
   apply (auto)
  by (metis (no_types, lifting) filter_True filter_append mem_Collect_eq set_filter)
  
lemma member_singD:"⋀x P. P x ⟹ (⋀y. List.member [x] y ⟹ P y)"
  by (metis member_rec(1) member_rec(2))

lemma fst_neq:"A ≠ B ⟹ (A,C) ≠ (B,D)"
  by auto
  
lemma lrule_sound: "lrule_ok SG C i j L ⟹ i < length SG ⟹ j < length (fst (SG ! i)) ⟹ sound (SG,C) ⟹ sound (close (append SG (Lrule_result L j (nth SG i))) (nth SG i), C)"
proof(induction rule: lrule_ok.induct)
  case (Lrule_And SG i j C p q)
  assume eq:"fst (SG ! i) ! j = (p && q)"
  assume sound:"sound (SG, C)"
  obtain AI and SI where SG_dec:"(AI,SI) = (SG ! i)"
    by (metis seq2fml.cases)
  have AIjeq:"AI ! j = (p && q)" using SG_dec eq
    by (metis fst_conv)
  have sub:"sublist [(close ([p, q] @ AI) (p && q),SI)] ([y←SG . y ≠ (AI, SI)] @ [y← [(close (p # q # AI) (p && q), SI)] . y ≠ (AI, SI)])"
    apply (rule sublistI)
    using member_singD [of "λy. List.member ([y←SG . y ≠ (AI, SI)] @ [y← [(close ([p, q] @ AI) (p && q), SI)] . y ≠ (AI, SI)]) y" "(close ([p, q] @ AI) (p && q),SI)"]
    using close_app_neq[of "[p, q]" p "p && q" AI] 
    by(auto intro: member_intros fst_neq simp add: member_rec expr_diseq)
  have cool:"sound ([y←SG . y ≠ (AI, SI)] @ [y← [(close (p # q # AI) (p && q), SI)] . y ≠ (AI, SI)], AI, SI)"
    apply(rule sound_weaken_gen[OF sub] )
    apply(auto simp add: member_rec expr_diseq)
    unfolding seq_valid_def
  proof (rule soundI_mem)
    fix I::"('sf,'sc,'sz) interp"
    assume good:"is_interp I"
    assume sgs:"(⋀φ. List.member [(p # q # [y←AI . y ≠ (p && q)], SI)] φ ⟹ seq_sem I φ = UNIV)"
    have theSg:"seq_sem I (p # q # [y←AI . y ≠ (p && q)], SI) = UNIV"
      apply(rule sgs)
      by(auto intro: member_intros)
    then have sgIn:"⋀ν. ν ∈ seq_sem I ((p && q) # [y←AI . y ≠ (p && q)], SI)"
      by auto
    { fix ν
      assume sem:"ν ∈ seq_sem I ((p && q) # [y←AI . y ≠ (p && q)], SI)"
      have mem_eq:"⋀x. List.member ((p && q) # [y←AI . y ≠ (p && q)]) x = List.member AI x"
        by (metis (mono_tags, lifting) Lrule_And.prems(2) SG_dec eq fst_conv local.member_filter mem_filter member_rec(1) nth_member)
      have myeq:"ν ∈ seq_sem I ((p && q) # [y←AI . y ≠ (p && q)], SI) ⟹  ν ∈ seq_sem I (AI, SI)"
        using and_foldl_sem and_foldl_sem_conv seq_semI Lrule_And.prems(2) SG_dec eq  seq_MP seq_semI' mem_eq
        by (metis (no_types, lifting))
      have "ν ∈ seq_sem I ((p && q) # [y←AI . y ≠ (p && q)], SI)"
        using sem by auto
      then have "ν ∈ seq_sem I ((p && q) # [y←AI . y ≠ (p && q)], SI)"
        by blast
      then have "ν ∈ seq_sem I (AI, SI)"
        using myeq by auto}
      then show "seq_sem I (AI, SI) = UNIV"
        using sgIn by blast
    qed
  have res_sound:"sound ([y←SG . y ≠ (AI,SI)] @ [y←Lrule_result AndL j (AI,SI) . y ≠ (AI,SI)],(AI,SI))"
    apply (simp)
    using cool AIjeq by auto
 show "?case"
  apply(rule close_provable_sound)
   apply(rule sound_weaken_appR)
   apply(rule sound)
  using res_sound SG_dec by auto
next
  case (Lrule_Imply SG i j C p q)
  have implyL_simp:"⋀AI SI SS p q. 
    (nth AI  j) = (Not (And (Not q) (Not (Not p)))) ⟹ 
    (AI,SI) = SS ⟹ 
    Lrule_result ImplyL j SS = [(close (q # AI) (nth AI j), SI), (close AI (nth AI j), p # SI)]"
    subgoal for AI SI SS p q apply(cases SS) by auto done
  assume eq:"fst (SG ! i) ! j = (p → q)"
  assume iL:"i < length SG"
  assume jL:"j < length (fst (SG ! i))"
  assume sound:"sound (SG, C)"
  obtain Γ and Δ where SG_dec:"(Γ,Δ) = (SG ! i)"
    by (metis seq2fml.cases)
  have res_eq:"Lrule_result ImplyL j (SG ! i) = 
    [(close (q # Γ) (nth Γ j), Δ), 
     (close Γ (nth Γ j), p # Δ)]"
    apply(rule implyL_simp)
    using SG_dec eq Implies_def Or_def 
    by (metis fstI)+
  have AIjeq:"Γ ! j = (p → q)" 
    using SG_dec eq unfolding Implies_def Or_def
    by (metis fst_conv)
  have big_sound:"sound ([(close (q # Γ) (p → q), Δ), (close Γ (p → q), p # Δ)], (Γ,Δ))"
    apply(rule soundI')
    apply(rule seq_semI')
  proof -
    fix I::"('sf,'sc,'sz) interp" and ν::"'sz state"
    assume good:"is_interp I"
    assume sgs:"(⋀i. 0 ≤ i ⟹
             i < length [(close (q # Γ) (p → q), Δ), (close Γ (p → q), p # Δ)] ⟹
             ν ∈ seq_sem I ([(close (q # Γ) (p → q), Δ), (close Γ (p → q), p # Δ)] ! i))"
    have sg1:"ν ∈ seq_sem I (close (q # Γ) (p → q), Δ)" using sgs[of 0] by auto
    have sg2:"ν ∈ seq_sem I (close Γ (p → q), p # Δ)" using sgs[of "Suc 0"] by auto
    assume Γ:"ν ∈ fml_sem I (foldr And Γ TT)"
    have Γ_proj:"⋀φ Γ. List.member Γ φ ⟹ ν ∈ fml_sem I (foldr And Γ TT) ⟹ ν ∈ fml_sem I φ"
      apply(induction Γ, auto simp add: member_rec)
      using and_foldl_sem by blast
    have imp:"ν ∈ fml_sem I (p → q)" 
      apply(rule Γ_proj[of Γ])
      using AIjeq  jL SG_dec nth_member
      apply (metis fst_conv)
      by (rule Γ)
    have sub:"sublist (close Γ (p → q)) Γ"
      by (rule close_sub)
    have ΓC:"ν ∈ fml_sem I (foldr And (close Γ (p → q)) TT)"
      by (rule Γ_sub_sem[OF sub Γ])
    have "ν ∈ fml_sem I (foldr (||) (p # Δ) FF)"
      by(rule seq_MP[OF sg2 ΓC])
    then have disj:"ν ∈ fml_sem I p ∨ ν ∈ fml_sem I (foldr (||) Δ FF)"
      by auto 
    { assume p:"ν ∈ fml_sem I p"
      have q:"ν ∈ fml_sem I q" using p imp by simp
      have res: "ν ∈ fml_sem I (foldr (||) Δ FF)" 
        using disj Γ seq_semI
        proof -
          have "ν ∈ fml_sem I (foldr (&&) (q # Γ) TT)"
            using Γ q by auto
          then show ?thesis
            by (meson Γ_sub_sem close_sub seq_MP sg1)
        qed
      have conj:"ν ∈ fml_sem I (foldr (&&) (q # Γ) TT)"
        using q Γ by auto
      have conj:"ν ∈ fml_sem I (foldr (&&) (close (q # Γ) (p → q)) TT)"
        apply(rule Γ_sub_sem)
        defer
        apply(rule conj)
        by(rule close_sub)
      have Δ1:"ν ∈ fml_sem I (foldr (||) Δ FF)"
        by(rule seq_MP[OF sg1 conj])
      }
    then show "ν ∈ fml_sem I (foldr (||) Δ FF)"
      using disj by auto
    qed
    have neq1:"close ([q] @ Γ) (p → q) ≠ Γ"
      apply(rule close_app_neq)
       apply(rule mem_sing)
      by (auto simp add: expr_diseq)
    have neq2:"p # Δ ≠ Δ"
      by(induction p, auto)
    have close_eq:"close [(close (q # Γ) (p → q), Δ), (close Γ (p → q), p # Δ)] (Γ,Δ) = [(close (q # Γ) (p → q), Δ), (close Γ (p → q), p # Δ)]"
      apply(rule close_nonmember_eq)
      apply auto
       using neq1 neq2  
       apply (simp add: member_rec)
    proof -
      assume a1: "q = (p → q)"
      assume "List.member [([y←Γ . y ≠ q], Δ), ([y←Γ . y ≠ q], p # Δ)] (Γ, Δ)"
        then have "[f←Γ . f ≠ q] = Γ"
      by (simp add: member_rec)
      then show False
        using a1 neq1 by fastforce
    qed       
  show ?case 
    apply(rule close_provable_sound)
     apply(rule sound_weaken_appR)
     apply(rule sound)
    apply(unfold res_eq)
    apply(unfold AIjeq)
    unfolding close_app_comm
    apply (rule sound_weaken_appL)
    using close_eq big_sound SG_dec   
    by simp
next
  case (Lrule_EquivBackward SG i j C p q)
  have equivLBackward_simp:"⋀AI SI SS p q. 
    (nth AI  j) = Not (And (Not (And p q)) (Not (And (Not p) (Not q)))) ⟹ 
    (AI,SI) = SS ⟹ 
    Lrule_result EquivBackwardL j SS = [(close (p # AI) (nth AI j), SI), (close AI (nth AI j), q # SI)]"
    subgoal for AI SI SS p q apply(cases SS) by auto done
  assume eq:"fst (SG ! i) ! j = (p ↔ q)"
  assume iL:"i < length SG"
  assume jL:"j < length (fst (SG ! i))"
  assume sound:"sound (SG, C)"
  obtain Γ and Δ where SG_dec:"(Γ,Δ) = (SG ! i)"
    by (metis seq2fml.cases)
  have res_eq:"Lrule_result EquivBackwardL j (SG ! i) = 
    [(close (p # Γ) (nth Γ j), Δ), 
     (close Γ (nth Γ j), q # Δ)]"
    apply(rule equivLBackward_simp)
     using SG_dec eq Equiv_def Or_def 
     by (metis fstI)+
  have AIjeq:"Γ ! j = (p ↔ q)" 
    using SG_dec eq unfolding Implies_def Or_def
    by (metis fst_conv)
  have big_sound:"sound ([(close (p # Γ) (p ↔ q), Δ), (close Γ (p ↔ q), q # Δ)], (Γ,Δ))"
    apply(rule soundI')
    apply(rule seq_semI')
  proof -
    fix I::"('sf,'sc,'sz) interp" and ν::"'sz state"
    assume good:"is_interp I"
    assume sgs:"(⋀i. 0 ≤ i ⟹
             i < length [(close (p # Γ) (p ↔ q), Δ), (close Γ (p ↔ q), q # Δ)] ⟹
             ν ∈ seq_sem I ([(close (p # Γ) (p ↔ q), Δ), (close Γ (p ↔ q), q # Δ)] ! i))"
    have sg1:"ν ∈ seq_sem I (close (p # Γ) (p ↔ q), Δ)" using sgs[of 0] by auto
    have sg2:"ν ∈ seq_sem I (close Γ (p ↔ q), q # Δ)" using sgs[of "Suc 0"] by auto 
    assume Γ:"ν ∈ fml_sem I (foldr And Γ TT)"
    have Γ_proj:"⋀φ Γ. List.member Γ φ ⟹ ν ∈ fml_sem I (foldr And Γ TT) ⟹ ν ∈ fml_sem I φ"
      apply(induction Γ, auto simp add: member_rec)
      using and_foldl_sem by blast
    have imp:"ν ∈ fml_sem I (p ↔ q)" 
      apply(rule Γ_proj[of Γ])
      using AIjeq  jL SG_dec nth_member
      apply (metis fst_conv)
      by (rule Γ)
    have sub:"sublist (close Γ (p → q)) Γ"
      by (rule close_sub)
    have ΓC:"ν ∈ fml_sem I (foldr And (close Γ (p → q)) TT)"
      by (rule Γ_sub_sem[OF sub Γ])
    have "ν ∈ fml_sem I (foldr (||) (p # Δ) FF)"
      by (metis Γ Γ_sub_sem close_sub iff_sem imp member_rec(1) or_foldl_sem or_foldl_sem_conv seq_MP sg2)
    then have disj:"ν ∈ fml_sem I p ∨ ν ∈ fml_sem I (foldr (||) Δ FF)"
      by auto 
    { assume p:"ν ∈ fml_sem I p"
      have q:"ν ∈ fml_sem I q" using p imp by simp
      have res: "ν ∈ fml_sem I (foldr (||) Δ FF)" 
        using disj Γ seq_semI
        proof -
          have "ν ∈ fml_sem I (foldr (&&) (q # Γ) TT)"
            using Γ q by auto
          then show ?thesis
            proof -
              have "∀fs p i. (∃f. List.member fs (f::('sf, 'sc, 'sz) formula) ∧ p ∉ fml_sem i f) ∨ p ∈ fml_sem i (foldr (&&) fs TT)"
                using and_foldl_sem_conv by blast
              then obtain ff :: "('sf, 'sc, 'sz) formula list ⇒ (real, 'sz) vec × (real, 'sz) vec ⇒ ('sf, 'sc, 'sz) interp ⇒ ('sf, 'sc, 'sz) formula" where
                f1: "∀fs p i. List.member fs (ff fs p i) ∧ p ∉ fml_sem i (ff fs p i) ∨ p ∈ fml_sem i (foldr (&&) fs TT)"
                by metis
              have "⋀f. ν ∈ fml_sem I f ∨ ¬ List.member Γ f"
                by (meson ‹ν ∈ fml_sem I (foldr (&&) (q # Γ) TT)› and_foldl_sem member_rec(1))
              then have "ν ∈ fml_sem I (foldr (&&) (close (p # Γ) (p ↔ q)) TT)"
                using f1 by (metis (no_types) close_sub local.sublist_def member_rec(1) p)
              then show ?thesis
                using seq_MP sg1 by blast
            qed
        qed
      have conj:"ν ∈ fml_sem I (foldr (&&) (q # Γ) TT)"
        using q Γ by auto
      have conj:"ν ∈ fml_sem I (foldr (&&) (close (q # Γ) (p → q)) TT)"
        apply(rule Γ_sub_sem)
        defer
        apply(rule conj)
        by(rule close_sub)
      have Δ1:"ν ∈ fml_sem I (foldr (||) Δ FF)"
        using res by blast
      }
    then show "ν ∈ fml_sem I (foldr (||) Δ FF)"
      using disj by auto
  qed
  have neq1:"close ([q] @ Γ) (p ↔ q) ≠ Γ"
    apply(rule close_app_neq)
     apply(rule mem_sing)
    by (auto simp add: expr_diseq)
  have neq2:"p # Δ ≠ Δ"
    by(induction p, auto)                 
  have close_eq:"close [(close (p # Γ) (p ↔ q), Δ), (close Γ (p ↔ q), q # Δ)] (Γ,Δ) = [(close (p # Γ) (p ↔ q), Δ), (close Γ (p ↔ q), q # Δ)]"
    apply(rule close_nonmember_eq)
    apply auto
     using neq1 neq2  
     apply (simp add: member_rec)
     apply (metis append_Cons append_Nil close.simps close_app_neq member_rec(1))
    proof -
       assume a1:"p = (p ↔ q)"
       then show False
         by (simp add: expr_diseq)
    qed
  show ?case 
    apply(rule close_provable_sound)
     apply(rule sound_weaken_appR)
     apply(rule sound)
    apply(unfold res_eq)
    apply(unfold AIjeq)
    unfolding close_app_comm
    apply (rule sound_weaken_appL)
    using close_eq big_sound SG_dec   
    by simp
next
  case (Lrule_EquivForward SG i j C p q)
  have equivLForward_simp:"⋀AI SI SS p q. 
    (nth AI  j) = Not (And (Not (And p q)) (Not (And (Not p) (Not q)))) ⟹ 
    (AI,SI) = SS ⟹ 
    Lrule_result EquivForwardL j SS = [(close (q # AI) (nth AI j), SI), (close AI (nth AI j), p # SI)]"
    subgoal for AI SI SS p q apply(cases SS) by auto done
  assume eq:"fst (SG ! i) ! j = (p ↔ q)"
  assume iL:"i < length SG"
  assume jL:"j < length (fst (SG ! i))"
  assume sound:"sound (SG, C)"
  obtain Γ and Δ where SG_dec:"(Γ,Δ) = (SG ! i)"
    by (metis seq2fml.cases)
  have res_eq:"Lrule_result EquivForwardL j (SG ! i) = 
    [(close (q # Γ) (nth Γ j), Δ), 
     (close Γ (nth Γ j), p # Δ)]"
    apply(rule equivLForward_simp)
    using SG_dec eq Equiv_def Or_def 
    by (metis fstI)+
  have AIjeq:"Γ ! j = (p ↔ q)" 
    using SG_dec eq unfolding Implies_def Or_def
    by (metis fst_conv)
  have big_sound:"sound ([(close (q # Γ) (p ↔ q), Δ), (close Γ (p ↔ q), p # Δ)], (Γ,Δ))"
    apply(rule soundI')
    apply(rule seq_semI')
  proof -
    fix I::"('sf,'sc,'sz) interp" and ν::"'sz state"
    assume good:"is_interp I"
    assume sgs:"(⋀i. 0 ≤ i ⟹
             i < length [(close (q # Γ) (p ↔ q), Δ), (close Γ (p ↔ q), p # Δ)] ⟹
             ν ∈ seq_sem I ([(close (q # Γ) (p ↔ q), Δ), (close Γ (p ↔ q), p # Δ)] ! i))"
    have sg1:"ν ∈ seq_sem I (close (q # Γ) (p ↔ q), Δ)" using sgs[of 0] by auto
    have sg2:"ν ∈ seq_sem I (close Γ (p ↔ q), p # Δ)" using sgs[of "Suc 0"] by auto 
    assume Γ:"ν ∈ fml_sem I (foldr And Γ TT)"
    have Γ_proj:"⋀φ Γ. List.member Γ φ ⟹ ν ∈ fml_sem I (foldr And Γ TT) ⟹ ν ∈ fml_sem I φ"
      apply(induction Γ, auto simp add: member_rec)
      using and_foldl_sem by blast
    have imp:"ν ∈ fml_sem I (p ↔ q)" 
      apply(rule Γ_proj[of Γ])
       using AIjeq  jL SG_dec nth_member
       apply (metis fst_conv)
      by (rule Γ)
    have sub:"sublist (close Γ (p → q)) Γ"
      by (rule close_sub)
    have ΓC:"ν ∈ fml_sem I (foldr And (close Γ (p → q)) TT)"
      by (rule Γ_sub_sem[OF sub Γ])
    have "ν ∈ fml_sem I (foldr (||) (p # Δ) FF)"
      by (metis Γ Γ_sub_sem close_sub iff_sem imp member_rec(1) or_foldl_sem or_foldl_sem_conv seq_MP sg2)
    then have disj:"ν ∈ fml_sem I p ∨ ν ∈ fml_sem I (foldr (||) Δ FF)"
      by auto 
    { assume p:"ν ∈ fml_sem I p"
      have q:"ν ∈ fml_sem I q" using p imp by simp
      have res: "ν ∈ fml_sem I (foldr (||) Δ FF)" 
        using disj Γ seq_semI
        proof -
          have "ν ∈ fml_sem I (foldr (&&) (q # Γ) TT)"
            using Γ q by auto
          then show ?thesis
            by (meson ‹ν ∈ fml_sem I (foldr (&&) (q # Γ) TT)› and_foldl_sem and_foldl_sem_conv close_sub local.sublist_def seq_MP sg1)
        qed
      have conj:"ν ∈ fml_sem I (foldr (&&) (q # Γ) TT)"
        using q Γ by auto
      have conj:"ν ∈ fml_sem I (foldr (&&) (close (q # Γ) (p → q)) TT)"
        apply(rule Γ_sub_sem)
        defer
        apply(rule conj)
        by(rule close_sub)
      have Δ1:"ν ∈ fml_sem I (foldr (||) Δ FF)"
        using res by blast
      }
    then show "ν ∈ fml_sem I (foldr (||) Δ FF)"
      using disj by auto
  qed
  have neq1:"close ([q] @ Γ) (p ↔ q) ≠ Γ"
    apply(rule close_app_neq)
    apply(rule mem_sing)
    by (auto simp add: expr_diseq)
  have neq2:"p # Δ ≠ Δ"
    by(induction p, auto)
  have close_eq:"close [(close (q # Γ) (p ↔ q), Δ), (close Γ (p ↔ q), p # Δ)] (Γ,Δ) = [(close (q # Γ) (p ↔ q), Δ), (close Γ (p ↔ q), p # Δ)]"
    apply(rule close_nonmember_eq)
    apply auto
     using neq1 neq2  
     apply (simp add: member_rec)
  proof -
     assume a1:"q = (p ↔ q)"
     then show False
       by (simp add: expr_diseq)
  qed
  show ?case 
    apply(rule close_provable_sound)
     apply(rule sound_weaken_appR)
     apply(rule sound)
    apply(unfold res_eq)
    apply(unfold AIjeq)
    unfolding close_app_comm
    apply (rule sound_weaken_appL)
    using close_eq big_sound SG_dec   
  by simp
qed

lemma rrule_sound: "rrule_ok SG C i j L ⟹ i < length SG ⟹ j < length (snd (SG ! i)) ⟹ sound (SG,C) ⟹ sound (close (append SG (Rrule_result L j (nth SG i))) (nth SG i), C)"
proof(induction rule: rrule_ok.induct)
  case (Rrule_And SG i j C p q)
  assume eq:"snd (SG ! i) ! j = (p && q)"
  assume "i < length SG"
  assume "j < length (snd (SG ! i))"
  assume sound:"sound (SG, C)"
  obtain Γ and Δ where SG_dec:"(Γ,Δ) = (SG ! i)"
    by (metis seq2fml.cases)
  have andR_simp:"⋀Γ Δ SS p q. 
    (nth Δ j) = And p q ⟹ 
    (Γ,Δ) = SS ⟹ 
    Rrule_result AndR j SS = [(Γ, p # (close Δ (nth Δ j))), (Γ, q # (close Δ (nth Δ j)))]"
    subgoal for AI SI SS p q apply(cases SS) by auto done
  have res_eq:"Rrule_result AndR j (SG ! i) = 
    [(Γ, p # (close Δ (nth Δ j))), (Γ, q # (close Δ (nth Δ j)))]"
    using SG_dec andR_simp apply auto
    using SG_dec eq Implies_def Or_def
    using fstI
    by (metis andR_simp close.simps snd_conv)
  have AIjeq:"Δ ! j = (p && q)" 
    using SG_dec eq snd_conv
    by metis
  have big_sound:"sound ([(Γ, p # (close Δ (nth Δ j))), (Γ, q # (close Δ (nth Δ j)))], (Γ,Δ))"
    apply(rule soundI')
    apply(rule seq_semI')
  proof -
    fix I::"('sf,'sc,'sz) interp" and ν
    assume good:"is_interp I"
    assume sgs:"(⋀i. 0 ≤ i ⟹
             i < length [(Γ, p # close Δ (nth Δ  j)), (Γ, q # close Δ (nth Δ  j))] ⟹
             ν ∈ seq_sem I (nth [(Γ, p # close Δ (nth Δ  j)), (Γ, q # close Δ (nth Δ j))] i))"
    assume Γ_sem:"ν ∈ fml_sem I (foldr (&&) Γ TT)"
    have sg1:"ν ∈ seq_sem I (Γ, p # close Δ (nth Δ j))" using sgs[of 0] by auto
    have sg2:"ν ∈ seq_sem I (Γ, q # close Δ (nth Δ j))" using sgs[of 1] by auto
    have Δ1:"ν ∈ fml_sem I (foldr (||) (p # close Δ (nth Δ j)) FF)"
      by(rule seq_MP[OF sg1 Γ_sem])
    have Δ2:"ν ∈ fml_sem I (foldr (||) (q # close Δ (nth Δ j)) FF)"
      by(rule seq_MP[OF sg2 Γ_sem])
    have Δ':"ν ∈ fml_sem I (foldr (||) ((p && q) # close Δ (nth Δ j)) FF)"
      using Δ1 Δ2 by auto
    have mem_eq:"⋀x. List.member ((p && q) # close Δ (nth Δ j)) x ⟹ List.member Δ x"
      using Rrule_And.prems SG_dec eq  member_rec(1) nth_member
      by (metis close_sub local.sublist_def snd_conv)
    have myeq:"ν ∈ fml_sem I (foldr (||) ((p && q) # close Δ (nth Δ j)) FF) ⟹  ν ∈ fml_sem I (foldr (||) Δ FF)"
        using  seq_semI Rrule_And.prems SG_dec eq  seq_MP seq_semI' mem_eq
        or_foldl_sem or_foldl_sem_conv
        by metis
    then show "ν ∈ fml_sem I (foldr (||) Δ FF)"
      using Δ' by auto  
  qed
  have list_neqI1:"⋀L1 L2 x. List.member L1 x ⟹ ¬(List.member L2 x) ⟹ L1 ≠ L2"
    by(auto)
  have list_neqI2:"⋀L1 L2 x. ¬(List.member L1 x) ⟹ (List.member L2 x) ⟹ L1 ≠ L2"
    by(auto)
  have notin_cons:"⋀x y ys. x ≠ y ⟹ ¬(List.member ys x) ⟹ ¬(List.member (y # ys) x)"
    subgoal for x y ys
      by(induction ys, auto simp add: member_rec)
    done
  have notin_close:"⋀L x. ¬(List.member (close L x) x)"
    subgoal for L x
      by(induction L, auto simp add: member_rec)
    done
  have neq_lemma:"⋀L x y. List.member L x ⟹ y ≠ x ⟹ (y # (close L x)) ≠ L"
    subgoal for L x y
      apply(cases "List.member L y")
       subgoal
         apply(rule list_neqI2[of "y # close L x" x])
          apply(rule notin_cons)
           defer
           apply(rule notin_close)
          by(auto)
      subgoal
        apply(rule list_neqI2[of "y # close L x" x])
         apply(rule notin_cons)
          defer
          apply(rule notin_close)
         by(auto)
      done
    done
  have neq1:"p # close Δ (p && q) ≠ Δ"
    apply(rule neq_lemma)
     apply (metis Rrule_And.prems(2) SG_dec eq nth_member sndI)
    by(auto simp add: expr_diseq) 
  have neq2:"q # close Δ (p && q) ≠ Δ"
    apply(rule neq_lemma)
     apply (metis Rrule_And.prems(2) SG_dec eq nth_member sndI)
    by(auto simp add: expr_diseq)
  have close_eq:"close [(Γ, p # close Δ (p && q)), (Γ, q # close Δ (p && q))] (Γ,Δ) = [(Γ, p # close Δ (p && q)), (Γ, q # close Δ (p && q))]"
    apply(rule close_nonmember_eq)
    apply auto
    using neq1 neq2  
    by (simp add: member_rec)
  show " sound (close (SG @ Rrule_result AndR j (SG ! i)) (SG ! i), C)" 
    apply(rule close_provable_sound)
     apply(rule sound_weaken_appR)
     apply(rule sound)
    apply(unfold res_eq)
    apply(unfold AIjeq)
    unfolding close_app_comm
    apply (rule sound_weaken_appL)
    using close_eq big_sound SG_dec   
    by (simp add: AIjeq)
next
  case (Rrule_Imply SG i j C p q)
  assume eq:"snd (SG ! i) ! j = (p → q)"
  assume "i < length SG"
  assume "j < length (snd (SG ! i))"
  assume sound:"sound (SG, C)"
  obtain Γ and Δ where SG_dec:"(Γ,Δ) = (SG ! i)"
    by (metis seq2fml.cases)
  have impR_simp:"⋀Γ Δ SS p q. 
    (nth Δ j) = Implies p q ⟹ 
    (Γ,Δ) = SS ⟹ 
    Rrule_result ImplyR j SS = [(p # Γ, q # (close Δ (nth Δ j)))]"
    subgoal for AI SI SS p q apply(cases SS) by (auto simp add: Implies_def Or_def) done
  have res_eq:"Rrule_result ImplyR j (SG ! i) = 
    [(p # Γ, q # (close Δ (nth Δ j)))]"
    using SG_dec impR_simp apply auto
    using SG_dec eq Implies_def Or_def
    using fstI
    by (metis impR_simp close.simps snd_conv)
  have AIjeq:"Δ ! j = (p → q)" 
    using SG_dec eq snd_conv
    by metis
  have close_eq:"close [(p # Γ, q # (close Δ (nth Δ j)))] (Γ,Δ) = [(p # Γ, q # (close Δ (nth Δ j)))]"
    apply(rule close_nonmember_eq)
    by (simp add: member_rec)
  have big_sound:"sound ([(p # Γ, q # close Δ (Δ ! j))], (Γ,Δ))"
    apply(rule soundI')
    apply(rule seq_semI')
  proof -
    fix I ::"('sf,'sc,'sz) interp" and ν::"'sz state"
    assume "is_interp I"
    assume sgs:"(⋀i. 0 ≤ i ⟹ i < length [(p # Γ, q # close Δ (Δ ! j))] ⟹ ν ∈ seq_sem I ([(p # Γ, q # close Δ (Δ ! j))] ! i))"
      have sg:"ν ∈ seq_sem I (p # Γ, q # close Δ (Δ ! j))" using sgs[of 0] by auto
    assume Γ_sem:"ν ∈ fml_sem I (foldr (&&) Γ TT)"
    show "ν ∈ fml_sem I (foldr (||) Δ FF)"
      using Γ_sem sg 
        AIjeq Rrule_Imply.prems(2) SG_dec and_foldl_sem_conv close_sub impl_sem local.sublist_def member_rec(1) nth_member or_foldl_sem_conv seq_MP seq_semI snd_conv
        Γ_sub_sem and_foldl_sem or_foldl_sem seq_sem.simps sublistI
    proof -
      have f1: "∀fs p i. ∃f. (p ∈ fml_sem i (foldr (&&) fs (TT::('sf, 'sc, 'sz) formula)) ∨ List.member fs f) ∧ (p ∉ fml_sem i f ∨ p ∈ fml_sem i (foldr (&&) fs TT))"
        using and_foldl_sem_conv by blast
      have "∀p i fs. ∃f. ∀pa ia fa fb pb ib fc fd. p ∈ fml_sem i (f::('sf, 'sc, 'sz) formula) ∧ (pa ∈ fml_sem ia (fa::('sf, 'sc, 'sz) formula) ∨ pa ∈ fml_sem ia (fa → fb)) ∧ (pb ∉ fml_sem ib (fc::('sf, 'sc, 'sz) formula) ∨ pb ∈ fml_sem ib (fd → fc)) ∧ (p ∉ fml_sem i (foldr (||) fs FF) ∨ List.member fs f)"
        by (metis impl_sem or_foldl_sem_conv)
      then obtain ff :: "(real, 'sz) vec × (real, 'sz) vec ⇒ ('sf, 'sc, 'sz) interp ⇒ ('sf, 'sc, 'sz) formula list ⇒ ('sf, 'sc, 'sz) formula" where
        f2: "⋀p i fs pa ia f fa pb ib fb fc. p ∈ fml_sem i (ff p i fs) ∧ (pa ∈ fml_sem ia (f::('sf, 'sc, 'sz) formula) ∨ pa ∈ fml_sem ia (f → fa)) ∧ (pb ∉ fml_sem ib (fb::('sf, 'sc, 'sz) formula) ∨ pb ∈ fml_sem ib (fc → fb)) ∧ (p ∉ fml_sem i (foldr (||) fs FF) ∨ List.member fs (ff p i fs))"
        by metis
      then have "⋀fs. ν ∉ fml_sem I (foldr (&&) (p # Γ) TT) ∨ ¬ local.sublist (close Δ (p → q)) fs ∨ ff ν I (q # close Δ (p → q)) = q ∨ List.member fs (ff ν I (q # close Δ (p → q)))"
        by (metis (no_types) AIjeq local.sublist_def member_rec(1) seq_MP sg)
      then have "∃f. List.member Δ f ∧ ν ∈ fml_sem I f"
        using f2 f1 by (metis (no_types) AIjeq Rrule_Imply.prems(2) SG_dec Γ_sem and_foldl_sem close_sub member_rec(1) nth_member snd_conv)
      then show ?thesis
        using or_foldl_sem by blast
    qed
  qed
  show ?case
    apply(rule close_provable_sound)
     apply(rule sound_weaken_appR)
     apply(rule sound)
    using res_eq
    apply(unfold res_eq)
    apply(unfold AIjeq)
    unfolding close_app_comm
    apply (rule sound_weaken_appL)
    using close_eq big_sound SG_dec AIjeq
    by (simp add: AIjeq)
next
  case (Rrule_Cohide SG i j C)
  assume "i < length SG"
  assume "j < length (snd (SG ! i))"
  assume chg:"(⋀Γ q. (nth SG i) ≠ (Γ, [q]))"
  assume sound:"sound (SG, C)"
  obtain Γ and Δ where SG_dec:"(Γ,Δ) = (SG ! i)"
    by (metis seq2fml.cases)
  have cohideR_simp:"
    (Γ,Δ) = SS ⟹ 
    Rrule_result CohideR j SS = [(Γ, [nth Δ j])]" for Γ Δ SS p q
    by (cases SS, auto)
  have res_eq:"Rrule_result CohideR j (SG ! i) =  [(Γ, [nth Δ j])]"
    using SG_dec by (rule cohideR_simp)
  have close_eq:"close [(Γ, [nth Δ j])] (Γ,Δ) = [(Γ, [nth Δ j])]"
    using chg 
    by (metis SG_dec close_nonmember_eq member_rec(1) member_rec(2))
  have big_sound:"sound ([(Γ, [nth Δ j])], (Γ,Δ))"
    apply(rule soundI')
    apply(rule seq_semI')
    by (metis (no_types, lifting) Rrule_Cohide.prems(2) SG_dec length_greater_0_conv less_or_eq_imp_le list.distinct(1) member_singD nth_Cons_0 nth_member or_foldl_sem or_foldl_sem_conv seq_MP snd_conv)
  show ?case
    apply(rule close_provable_sound)
     apply(rule sound_weaken_appR)
     apply(rule sound)
    using res_eq
    apply(unfold res_eq)
    unfolding close_app_comm
    apply (rule sound_weaken_appL)
    using big_sound SG_dec
    apply(cases "[nth Δ j] = Δ")
     apply(auto)
    using chg by (metis)+
next
  case (Rrule_CohideRR SG i j C)
  assume "i < length SG"
  assume "j < length (snd (SG ! i))"
  assume chg:"(⋀q. (nth SG i) ≠ ([], [q]))"
  assume sound:"sound (SG, C)"
  obtain Γ and Δ where SG_dec:"(Γ,Δ) = (SG ! i)"
    by (metis seq2fml.cases)
  have cohideRR_simp:" 
    (Γ,Δ) = SS ⟹ 
    Rrule_result CohideRR j SS = [([], [nth Δ j])]" for Γ Δ SS p q
    by (cases SS, auto)
  have res_eq:"Rrule_result CohideRR j (SG ! i) =  [([], [nth Δ j])]"
    using SG_dec by (rule cohideRR_simp)
  have close_eq:"close [([], [nth Δ j])] (Γ,Δ) = [([], [nth Δ j])]"
    using chg 
    by (metis SG_dec close_nonmember_eq member_rec(1) member_rec(2))
  have big_sound:"sound ([([], [nth Δ j])], (Γ,Δ))"
    apply(rule soundI')
    apply(rule seq_semI')
    by (metis (no_types, lifting) Rrule_CohideRR.prems(2) SG_dec and_foldl_sem_conv length_greater_0_conv less_or_eq_imp_le list.distinct(1) member_rec(2) member_singD nth_Cons_0 nth_member or_foldl_sem or_foldl_sem_conv seq_MP snd_conv)
  show ?case
    apply(rule close_provable_sound)
     apply(rule sound_weaken_appR)
     apply(rule sound)
    using res_eq
    apply(unfold res_eq)
    unfolding close_app_comm
    apply (rule sound_weaken_appL)
    using big_sound SG_dec
    apply(cases "[nth Δ j] = Δ")
     apply(auto)
     using chg by (metis)+
next
  case (Rrule_True SG i j C)
  assume tt:"snd (SG ! i) ! j = TT"
  assume iL:"i < length SG"
  assume iJ:"j < length (snd (SG ! i))"
  assume sound:"sound (SG, C)"
  obtain Γ and Δ where SG_dec:"(Γ,Δ) = (SG ! i)"
    by (metis seq2fml.cases)
  have "⋀I ν. is_interp I ⟹ ν ∈ fml_sem I (foldr (||) Δ FF)"
    proof -
      fix I::"('sf,'sc,'sz)interp" and ν::"'sz state"
      assume good:"is_interp I"
      have mem2:"List.member Δ (Δ ! j)"
        using iJ nth_member 
        by (metis SG_dec snd_conv)
      then show "ν ∈ fml_sem I (foldr (||) Δ FF)"
        using mem2
        using or_foldl_sem 
        by (metis SG_dec UNIV_I snd_conv tt tt_sem)
    qed
  then have seq_valid:"seq_valid (SG ! i)"
    unfolding seq_valid_def using SG_dec
    by (metis UNIV_eq_I seq_semI')
  show ?case
    using closeI_valid_sound[OF sound seq_valid]
    by (simp add: sound_weaken_appR)
next
  case (Rrule_Equiv SG i j C p q)
  assume eq:"snd (SG ! i) ! j = (p ↔ q)"
  assume iL:"i < length SG"
  assume jL:"j < length (snd (SG ! i))"
  assume sound:"sound (SG, C)"
  obtain Γ and Δ where SG_dec:"(Γ,Δ) = (SG ! i)"
    by (metis seq2fml.cases)
  have equivR_simp:"⋀Γ Δ SS p q. 
    (nth Δ j) = Equiv p q ⟹ 
    (Γ,Δ) = SS ⟹ 
    Rrule_result EquivR j SS = [(p # Γ, q # (closeI Δ j)), (q # Γ, p # (closeI Δ j))]"
    subgoal for AI SI SS p q apply(cases SS) by (auto simp add: Equiv_def Implies_def Or_def) done
  have res_eq:"Rrule_result EquivR j (SG ! i) = 
    [(p # Γ, q # (closeI Δ j)), (q # Γ, p # (closeI Δ j))]"
    apply(rule equivR_simp)
    subgoal using eq SG_dec by (metis snd_conv)
    by (rule SG_dec) 
  have AIjeq:"Δ ! j = (p ↔ q)" 
    using SG_dec eq snd_conv
    by metis
  have close_eq:"close [(p # Γ, q # (closeI Δ j)), (q # Γ, p # (closeI Δ j))] (Γ,Δ) = [(p # Γ, q # (closeI Δ j)), (q # Γ, p # (closeI Δ j))]"
    apply(rule close_nonmember_eq)
    by (simp add: member_rec)
  have big_sound:"sound ([(p # Γ, q # (closeI Δ j)), (q # Γ, p # (closeI Δ j))], (Γ,Δ))"
    apply(rule soundI')
    apply(rule seq_semI')
  proof -
    fix I ::"('sf,'sc,'sz) interp" and ν::"'sz state"
    assume good:"is_interp I"
    assume sgs:"(⋀i. 0 ≤ i ⟹ i < length [(p # Γ, q # (closeI Δ j)), (q # Γ, p # (closeI Δ j))] ⟹ ν ∈ seq_sem I ([(p # Γ, q # (closeI Δ j)), (q # Γ, p # (closeI Δ j))] ! i))"
    have sg1:"ν ∈ seq_sem I (p # Γ, q # close Δ (Δ ! j))" using sgs[of 0] by auto
    have sg2:"ν ∈ seq_sem I (q # Γ, p # (closeI Δ j))" using sgs[of 1] by auto
    assume Γ_sem:"ν ∈ fml_sem I (foldr (&&) Γ TT)"
    have case1:"ν ∈ fml_sem I p ⟹ ν ∈ fml_sem I (foldr (||) Δ FF)"
    proof -
      assume sem:"ν ∈ fml_sem I p"
      have "ν ∈ fml_sem I (foldr (||) (q # (close Δ (nth Δ j))) FF)"
        using sem Γ_sem sg1 by auto
      then show "ν ∈ fml_sem I (foldr (||) Δ FF)"
        using AIjeq SG_dec close_sub[of Δ "nth Δ j"] iff_sem[of "ν" I p q] jL local.sublist_def
        member_rec(1)[of q "close Δ (nth Δ j)"] sem snd_conv
        or_foldl_sem_conv[of ν I "q # close Δ (nth Δ j)"]
        or_foldl_sem[of "Δ", where I=I and ν=ν]
        nth_member[of j "snd (SG ! i)"]
        by metis
    qed
    have case2:"ν ∉ fml_sem I p ⟹ ν ∈ fml_sem I (foldr (||) Δ FF)"
    proof -
      assume sem:"ν ∉ fml_sem I p"
      have "ν ∈ fml_sem I q ⟹  ν ∉ fml_sem I (foldr (||) Δ FF) ⟹ False"
        using  
          and_foldl_sem[OF Γ_sem]
          and_foldl_sem_conv
          closeI.simps
          close_sub
          local.sublist_def
          member_rec(1)[of "p" "closeI Δ j"]
          member_rec(1)[of "q" "Γ"]
          or_foldl_sem[of "Δ"]
          or_foldl_sem_conv[of ν  I "p # closeI Δ j"]
          sem
          sg2
          seq_MP[of ν I "q # Γ" "p # closeI Δ j", OF sg2]
      proof -
        assume a1: "ν ∈ fml_sem I q"
        assume a2: "ν ∉ fml_sem I (foldr (||) Δ FF)"
        obtain ff :: "('sf, 'sc, 'sz) formula" where
          "ν ∈ fml_sem I ff ∧ List.member (p # close Δ (Δ ! j)) ff"
          using a1 by (metis (no_types) ‹⋀φ. List.member Γ φ ⟹ ν ∈ fml_sem I φ› ‹⋀y. List.member (q # Γ) y = (q = y ∨ List.member Γ y)› ‹ν ∈ fml_sem I (foldr (&&) (q # Γ) TT) ⟹ ν ∈ fml_sem I (foldr (||) (p # closeI Δ j) FF)› ‹ν ∈ fml_sem I (foldr (||) (p # closeI Δ j) FF) ⟹ ∃φ. ν ∈ fml_sem I φ ∧ List.member (p # closeI Δ j) φ› and_foldl_sem_conv closeI.simps)
        then show ?thesis
          using a2 by (metis (no_types) ‹⋀φ ν I. ⟦List.member Δ φ; ν ∈ fml_sem I φ⟧ ⟹ ν ∈ fml_sem I (foldr (||) Δ FF)› ‹⋀y. List.member (p # closeI Δ j) y = (p = y ∨ List.member (closeI Δ j) y)› closeI.simps close_sub local.sublist_def sem)
      qed
      show "ν ∈ fml_sem I (foldr (||) Δ FF)"
        by (metis AIjeq SG_dec ‹⟦ν ∈ fml_sem I q; ν ∉ fml_sem I (foldr (||) Δ FF)⟧ ⟹ False› iff_sem jL nth_member or_foldl_sem sem snd_eqD)
    qed
    show "ν ∈ fml_sem I (foldr (||) Δ FF)"
      by(cases "ν ∈ fml_sem I p", (simp add: case1 case2)+)
    qed
  show ?case
    apply(rule close_provable_sound)
     apply(rule sound_weaken_appR)
     apply(rule sound)
    using res_eq
    apply(unfold res_eq)
    unfolding close_app_comm
    apply (rule sound_weaken_appL)
    using close_eq big_sound SG_dec AIjeq
    by (simp add: AIjeq)
qed

lemma step_sound:"step_ok R i S ⟹ i ≥ 0 ⟹ i < length (fst R) ⟹ sound R ⟹ sound (step_result R (i,S))"
proof(induction rule: step_ok.induct)
  case (Step_Axiom SG i a C)
  assume is_axiom:"SG ! i = ([], [get_axiom a])"
  assume sound:"sound (SG, C)"
  assume i0:"0 ≤ i"
  assume "i < length (fst (SG, C))"
  then have iL:"i < length (SG)" 
    by auto
  have "seq_valid ([], [get_axiom a])"
    apply(rule fml_seq_valid)
    by(rule axiom_valid)
  then have seq_valid:"seq_valid (SG ! i)"
    using is_axiom by auto
  ― ‹‹i0 iL››
  then show ?case 
    using closeI_valid_sound[OF sound seq_valid] by simp
next
  case (Step_AxSubst SG i a σ C)
  assume is_axiom:"SG ! i = ([], [Fsubst (get_axiom a) σ])"
  assume sound:"sound (SG, C)"
  assume ssafe:"ssafe σ"
  assume i0:"0 ≤ i"
  assume Fadmit:"Fadmit σ (get_axiom a)"
  assume "i < length (fst (SG, C))"
  then have iL:"i < length (SG)" 
    by auto
  have valid_axiom:"valid (get_axiom a)"
    by(rule axiom_valid)
  have subst_valid:"valid (Fsubst (get_axiom a) σ)"
    apply(rule subst_fml_valid)
       apply(rule Fadmit)
      apply(rule axiom_safe)
     apply(rule ssafe)
    by(rule valid_axiom)
  have "seq_valid ([], [(Fsubst (get_axiom a) σ)])"
    apply(rule fml_seq_valid)
    by(rule subst_valid)
  then have seq_valid:"seq_valid (SG ! i)"
    using is_axiom by auto
  ― ‹‹i0 iL››
  then show ?case 
    using closeI_valid_sound[OF sound seq_valid] by simp
next
  case (Step_Lrule R i j L)
  then show ?case
    using lrule_sound
    using step_result.simps(2) surj_pair
    by simp
next
  case (Step_Rrule R i SG j L)
  then show ?case 
    using rrule_sound
    using step_result.simps(2) surj_pair
    by simp
next
  case (Step_Cut φ i SG C)
  assume safe:"fsafe φ"
  assume "i < length (fst (SG, C))"
  then have iL:"i < length SG" by auto
  assume sound:"sound (SG, C)"
  obtain Γ and Δ where SG_dec:"(Γ,Δ) = (SG ! i)"
    by (metis seq2fml.cases)
  have "sound ((φ # Γ, Δ) # (Γ, φ # Δ) # [y←SG . y ≠ SG ! i], C)"
    apply(rule soundI_memv)
  proof -
    fix I::"('sf,'sc,'sz) interp" and ν::"'sz state"
    assume good:"is_interp I"
    assume sgs:"(⋀φ' ν. List.member ((φ # Γ, Δ) # (Γ, φ # Δ) # [y←SG . y ≠ SG ! i]) φ' ⟹ ν ∈ seq_sem I φ')"
    have sg1:"⋀ν. ν ∈ seq_sem I (φ # Γ, Δ)" using sgs by (meson member_rec(1))
    have sg2:"⋀ν. ν ∈ seq_sem I (Γ, φ # Δ)" using sgs by (meson member_rec(1))
    have sgs:"⋀φ ν. (List.member (close SG (nth SG i)) φ) ⟹ ν ∈ seq_sem I φ"
      using sgs  by (simp add: member_rec(1))
    then have sgs:"⋀φ ν. (List.member (close SG (Γ,Δ)) φ) ⟹ ν ∈ seq_sem I φ"
      using SG_dec by auto
    have sgNew:"⋀ν. ν ∈ seq_sem I (Γ, Δ)"
      using sg1 sg2 by auto
    have same_mem:"⋀x. List.member SG x ⟹ List.member ((Γ,Δ) # close SG (Γ,Δ)) x"
      subgoal for s
        by(induction SG, auto simp add: member_rec)
      done
    have SGS:"(⋀φ' ν. List.member SG φ' ⟹ ν ∈ seq_sem I φ')"
      using sgNew sgs same_mem member_rec(1) seq_MP
      by metis
    show "ν ∈ seq_sem I C"
      using sound apply simp
      apply(drule soundD_memv)
        apply(rule good)
       using SGS 
       apply blast
      by auto
  qed
  then show ?case 
    using SG_dec case_prod_conv
  proof -
    have "(⋀f. ((case nth SG i of (x, xa) ⇒ ((f x xa)::('sf, 'sc, 'sz) rule)) = (f Γ Δ)))"
      by (metis (no_types) SG_dec case_prod_conv)
    then show ?thesis
      by (simp add: ‹sound ((φ # Γ, Δ) # (Γ, φ # Δ) # [y←SG . y ≠ SG ! i], C)›)
  qed
next
  case (Step_G SG i C a p)
  assume eq:"SG ! i = ([], [([[a]]p)])"
  assume iL:"i < length (fst (SG, C))"
  assume sound:"sound (SG, C)"
  have "sound (([], [p]) # (close SG ([], [([[ a ]] p)])), C)"
    apply(rule soundI_memv)
  proof -
    fix I::"('sf,'sc,'sz) interp" and  ν::"'sz state"
    assume "is_interp I"
    assume sgs:"(⋀φ ν. List.member (([], [p]) # close SG ([], [([[a]]p)])) φ ⟹ ν ∈ seq_sem I φ)"
    have sg0:"(⋀ν. ν ∈ seq_sem I ([], [p]))"
      using sgs by (meson member_rec(1))
    then have sg0':"(⋀ν. ν ∈ seq_sem I ([], [([[a]]p)]))"
      by auto
    have sgTail:"(⋀φ ν. List.member (close SG ([], [([[a]]p)])) φ ⟹ ν ∈ seq_sem I φ)"
      using sgs by (simp add: member_rec(1))
    have same_mem:"⋀x. List.member SG x ⟹ List.member (([], [([[a]]p)]) # close SG ([], [([[a]]p)])) x"
      subgoal for s
        by(induction SG, auto simp add: member_rec)
      done
    have sgsC:"(⋀φ ν. List.member SG φ ⟹ ν ∈ seq_sem I φ)"
      apply auto
      using sgTail sg0' same_mem member_rec
      by (metis seq_MP)
    then show "ν ∈ seq_sem I C"
      using sound
      by (metis UNIV_eq_I ‹is_interp I› iso_tuple_UNIV_I soundD_mem)
  qed
  then show ?case 
    by(auto simp add: eq Box_def)
next
  case (Step_CloseId SG i j k C)
  assume match:"fst (SG ! i) ! j = snd (SG ! i) ! k"
  assume jL:"j < length (fst (SG ! i))"
  assume kL:"k < length (snd (SG ! i))"
  assume iL:"i < length (fst (SG, C))"
  then have iL:"i < length (SG)" 
    by auto
  assume sound:"sound (SG, C)"
  obtain Γ Δ where SG_dec:"(Γ, Δ) = SG ! i" 
    using prod.collapse by blast
  have jΓ:"j < length Γ"
    using SG_dec jL
    by (metis fst_conv)
  have kΔ:"k < length Δ"
    using SG_dec kL
    by (metis snd_conv)
  have "⋀I ν. is_interp I ⟹ ν ∈ fml_sem I (foldr (&&) Γ TT) ⟹ ν ∈ fml_sem I (foldr (||) Δ FF)"
  proof -
    fix I::"('sf,'sc,'sz)interp" and ν::"'sz state"
    assume good:"is_interp I"
    assume Γ_sem:"ν ∈ fml_sem I (foldr (&&) Γ TT)"
    have mem:"List.member Γ (Γ ! j)"
      using jΓ nth_member by blast
    have mem2:"List.member Δ (Δ ! k)"
      using kΔ nth_member by blast
    have "ν ∈ fml_sem I (Γ ! j)"
      using Γ_sem mem
      using and_foldl_sem by blast
    then have "ν ∈ fml_sem I (Δ ! k)"
      using match SG_dec
      by (metis fst_conv snd_conv)
    then show "ν ∈ fml_sem I (foldr (||) Δ FF)"
      using mem2
      using or_foldl_sem by blast
  qed
  then have seq_valid:"seq_valid (SG ! i)"
    unfolding seq_valid_def using SG_dec
    by (metis UNIV_eq_I seq_semI')
  then show "sound (step_result (SG, C) (i, CloseId j k))" 
    using closeI_valid_sound[OF sound seq_valid] by simp
next
  case (Step_DEAxiom_schema SG i ODE σ C )
  assume isNth:"nth SG i =
  ([], [Fsubst (([[EvolveODE (OProd (OSing vid1 (f1 fid1 vid1))ODE) (p1 vid2 vid1)]]P pid1) ↔
                ([[EvolveODE (OProd (OSing vid1 (f1 fid1 vid1))ODE) (p1 vid2 vid1)]][[DiffAssign vid1 (f1 fid1 vid1)]]P pid1)) σ])"
  assume FA:"Fadmit σ
   (([[EvolveODE (OProd (OSing vid1 (f1 fid1 vid1))ODE) (p1 vid2 vid1)]]P pid1) ↔
    ([[EvolveODE (OProd (OSing vid1 (f1 fid1 vid1))ODE) (p1 vid2 vid1)]][[DiffAssign vid1 (f1 fid1 vid1)]]P pid1))"
  assume disj:"{Inl vid1, Inr vid1} ∩ BVO ODE = {}"
  have schem_valid:"valid (([[EvolveODE (OProd (OSing vid1 (f1 fid1 vid1))ODE) (p1 vid2 vid1)]] (P pid1)) ↔
    ([[EvolveODE ((OProd (OSing vid1 (f1 fid1 vid1))ODE)) (p1 vid2 vid1)]]
    [[DiffAssign vid1 (f1 fid1 vid1)]]P pid1))"
    using DE_sys_valid[OF disj] by auto
  assume ssafe:"ssafe σ"
  assume osafe:"osafe ODE"
  have subst_valid:"valid (Fsubst (([[EvolveODE (OProd (OSing vid1 (f1 fid1 vid1))ODE) (p1 vid2 vid1)]]P pid1) ↔
                ([[EvolveODE (OProd (OSing vid1 (f1 fid1 vid1))ODE) (p1 vid2 vid1)]][[DiffAssign vid1 (f1 fid1 vid1)]]P pid1)) σ)"
    apply(rule subst_fml_valid)
       apply(rule FA)
      subgoal using disj by(auto simp add: f1_def Box_def p1_def P_def Equiv_def Or_def expand_singleton osafe, induction ODE, auto)
     subgoal by (rule ssafe)
    by (rule schem_valid)
  assume "0 ≤ i" 
  assume "i < length (fst (SG, C))" 
  assume sound:"sound (SG, C)"
  have "seq_valid ([], [(Fsubst (([[EvolveODE (OProd  (OSing vid1 (f1 fid1 vid1))ODE) (p1 vid2 vid1)]]P pid1) ↔
                ([[EvolveODE (OProd  (OSing vid1 (f1 fid1 vid1))ODE) (p1 vid2 vid1)]][[DiffAssign vid1 (f1 fid1 vid1)]]P pid1)) σ)])"
    apply(rule fml_seq_valid)
    by(rule subst_valid)
  then have seq_valid:"seq_valid (SG ! i)"
    using isNth by auto
  ― ‹‹i0 iL››
  then show ?case 
  using closeI_valid_sound[OF sound seq_valid] by simp
next
  case (Step_CE SG i φ ψ σ C)
  assume isNth:"SG ! i = ([], [Fsubst (InContext pid1 φ ↔ InContext pid1 ψ) σ])"
  assume valid:"valid (φ ↔ ψ)"
  assume FA:"Fadmit σ (InContext pid1 φ ↔ InContext pid1 ψ)"
  assume "0 ≤ i"
  assume "i < length (fst (SG, C))"
  assume sound:"sound (SG, C)"
  assume fsafe1:"fsafe φ"
  assume fsafe2:"fsafe ψ"
  assume ssafe:"ssafe σ"
  have schem_valid:"valid (InContext pid1 φ ↔ InContext pid1 ψ)"
    using valid unfolding valid_def 
    by (metis CE_holds_def CE_sound fml_sem.simps(7) iff_sem surj_pair valid_def)+
  have subst_valid:"valid (Fsubst (InContext pid1 φ ↔ InContext pid1 ψ) σ)"
    apply(rule subst_fml_valid)
       apply(rule FA)
      subgoal by(auto simp add: f1_def Box_def p1_def P_def Equiv_def Or_def expand_singleton fsafe1 fsafe2)
     subgoal by (rule ssafe)
    by (rule schem_valid)
  have "seq_valid ([], [Fsubst (InContext pid1 φ ↔ InContext pid1 ψ) σ])"
    apply(rule fml_seq_valid)
    by(rule subst_valid)
  then have seq_valid:"seq_valid (SG ! i)"
    using isNth by auto
  show "sound (step_result (SG, C) (i, CE φ ψ σ))"
    using closeI_valid_sound[OF sound seq_valid] by simp
next
  case (Step_CQ SG i p θ θ' σ C)
  assume isNth:"nth SG  i = ([], [Fsubst (Equiv (Prop p (singleton θ)) (Prop p (singleton θ'))) σ])"
  assume valid:"valid (Equals θ θ')"
  assume FA:"Fadmit σ ($φ p (singleton θ) ↔ $φ p (singleton θ'))"
  assume "0 ≤ i"
  assume "i < length (fst (SG, C))"
  assume sound:"sound (SG, C)"
  assume dsafe1:"dsafe θ"
  assume dsafe2:"dsafe θ'"
  assume ssafe:"ssafe σ"
  have schem_valid:"valid ($φ p (singleton θ) ↔ $φ p (singleton θ'))"
    using valid unfolding valid_def 
    by (metis CQ_holds_def CQ_sound fml_sem.simps(7) iff_sem surj_pair valid_def)+
  have subst_valid:"valid (Fsubst ($φ p (singleton θ) ↔ $φ p (singleton θ')) σ)"
    apply(rule subst_fml_valid)
       apply(rule FA)
      using schem_valid ssafe by (auto simp add: f1_def Box_def p1_def P_def Equiv_def Or_def expand_singleton dsafe1 dsafe2 expand_singleton) 
  have "seq_valid ([], [Fsubst ($φ p (singleton θ) ↔ $φ p (singleton θ')) σ])"
    apply(rule fml_seq_valid)
    by(rule subst_valid)
  then have seq_valid:"seq_valid (SG ! i)"
    using isNth by auto
  show "sound (step_result (SG, C) (i, CQ θ θ' σ))"
    using closeI_valid_sound[OF sound seq_valid] by simp
qed

lemma deriv_sound:"deriv_ok R D ⟹ sound R ⟹ sound (deriv_result R D)"
  apply(induction rule: deriv_ok.induct)
   using step_sound by auto

lemma proof_sound:"proof_ok Pf ⟹ sound (proof_result Pf)"
  apply(induct rule: proof_ok.induct)
  unfolding proof_result.simps  apply(rule deriv_sound)
  apply assumption
  by(rule start_proof_sound)
  
section ‹Example 1: Differential Invariants›

definition DIAndConcl::"('sf,'sc,'sz) sequent"
where "DIAndConcl = ([], [Implies (And (Predicational pid1) (Predicational pid2)) 
       (Implies ([[Pvar vid1]](And (Predicational pid3) (Predicational pid4))) 
                ([[Pvar vid1]](And (Predicational pid1) (Predicational pid2))))])"

definition DIAndSG1::"('sf,'sc,'sz) formula"
where "DIAndSG1 = (Implies (Predicational pid1) (Implies ([[Pvar vid1]](Predicational pid3)) ([[Pvar vid1]](Predicational pid1))))"

definition DIAndSG2::"('sf,'sc,'sz) formula"
where "DIAndSG2 = (Implies (Predicational pid2) (Implies ([[Pvar vid1]](Predicational pid4)) ([[Pvar vid1]](Predicational pid2))))"

definition DIAndCut::"('sf,'sc,'sz) formula"
where "DIAndCut = 
  (([[$α vid1]]((And (Predicational ( pid3)) (Predicational ( pid4)))) → (And (Predicational ( pid1)) (Predicational ( pid2))))
    → ([[$α vid1]](And (Predicational ( pid3)) (Predicational ( pid4)))) → ([[$α vid1]](And (Predicational (pid1)) (Predicational ( pid2)))))"
  
definition DIAndSubst::"('sf,'sc,'sz) subst"
where "DIAndSubst = 
  ⦇ SFunctions = (λ_. None),
    SPredicates = (λ_. None),
    SContexts = (λC. (if C = pid1 then Some(And (Predicational (Inl pid3)) (Predicational (Inl pid4))) 
                else (if C = pid2 then Some(And (Predicational (Inl pid1)) (Predicational (Inl pid2))) else None))),
    SPrograms = (λ_. None),
    SODEs = (λ_. None)
  ⦈"
  
― ‹‹[a]R&H->R->[a]R&H->[a]R DIAndSubst34››
definition DIAndSubst341::"('sf,'sc,'sz) subst"
where "DIAndSubst341 = 
  ⦇ SFunctions = (λ_. None),
    SPredicates = (λ_. None),
    SContexts = (λC. (if C = pid1 then Some(And (Predicational (Inl pid3)) (Predicational (Inl pid4))) 
                else (if C = pid2 then Some(Predicational (Inl pid3)) else None))),
    SPrograms = (λ_. None),
    SODEs = (λ_. None)
  ⦈"
definition DIAndSubst342::"('sf,'sc,'sz) subst"
where "DIAndSubst342 = 
  ⦇ SFunctions = (λ_. None),
    SPredicates = (λ_. None),
    SContexts = (λC. (if C = pid1 then Some(And (Predicational (Inl pid3)) (Predicational (Inl pid4))) 
                else (if C = pid2 then Some(Predicational (Inl pid4)) else None))),
    SPrograms = (λ_. None),
    SODEs = (λ_. None)
  ⦈"
  
― ‹‹[a]P, [a]R&H, P, Q |- [a]Q->P&Q->[a]Q->[a]P&Q, [a]P&Q;;››
definition DIAndSubst12::"('sf,'sc,'sz) subst"
where "DIAndSubst12 = 
  ⦇ SFunctions = (λ_. None),
    SPredicates = (λ_. None),
    SContexts = (λC. (if C = pid1 then Some(Predicational (Inl pid2)) 
                else (if C = pid2 then Some(Predicational (Inl pid1) && Predicational (Inl pid2)) else None))),
    SPrograms = (λ_. None),
    SODEs = (λ_. None)
  ⦈"

― ‹‹P ->  Q->P&Q››
definition DIAndCurry12::"('sf,'sc,'sz) subst"
where "DIAndCurry12 = 
  ⦇ SFunctions = (λ_. None),
    SPredicates = (λ_. None),
    SContexts = (λC. (if C = pid1 then Some(Predicational (Inl pid1)) 
                else (if C = pid2 then Some(Predicational (Inl pid2) → (Predicational (Inl pid1) && Predicational (Inl pid2))) else None))),
    SPrograms = (λ_. None),
    SODEs = (λ_. None)
  ⦈"
  
definition DIAnd :: "('sf,'sc,'sz) rule" 
where "DIAnd = 
  ([([],[DIAndSG1]),([],[DIAndSG2])], 
  DIAndConcl)"

definition DIAndCutP1 :: "('sf,'sc,'sz) formula"
where "DIAndCutP1 = ([[Pvar vid1]](Predicational pid1))" 

definition DIAndCutP2 :: "('sf,'sc,'sz) formula"
where "DIAndCutP2 = ([[Pvar vid1]](Predicational pid2))" 

definition DIAndCutP12 :: "('sf,'sc,'sz) formula"
where "DIAndCutP12 = (([[Pvar vid1]](Pc pid1) → (Pc pid2 → (And (Pc pid1) (Pc pid2))))
  → (([[Pvar vid1]]Pc pid1) → ([[Pvar vid1]](Pc pid2 → (And (Pc pid1) (Pc pid2))))))" 

definition DIAndCut34Elim1 :: "('sf,'sc,'sz) formula"
where "DIAndCut34Elim1 = (([[Pvar vid1]](Pc pid3 && Pc pid4) → (Pc pid3))
  → (([[Pvar vid1]](Pc pid3 && Pc pid4)) → ([[Pvar vid1]](Pc pid3))))" 

definition DIAndCut34Elim2 :: "('sf,'sc,'sz) formula"
where "DIAndCut34Elim2 = (([[Pvar vid1]](Pc pid3 && Pc pid4) → (Pc pid4))
  → (([[Pvar vid1]](Pc pid3 && Pc pid4)) → ([[Pvar vid1]](Pc pid4))))" 

definition DIAndCut12Intro :: "('sf,'sc,'sz) formula"
where "DIAndCut12Intro = (([[Pvar vid1]](Pc pid2  → (Pc pid1 && Pc pid2)))
  → (([[Pvar vid1]](Pc pid2)) → ([[Pvar vid1]](Pc pid1 && Pc pid2))))" 

definition DIAndProof :: "('sf, 'sc, 'sz) pf"
where "DIAndProof =
  (DIAndConcl, [
   (0, Rrule ImplyR 0)  ― ‹1›
  ,(0, Lrule AndL 0)
  ,(0, Rrule ImplyR 0)
  ,(0, Cut DIAndCutP1)
  ,(1, Cut DIAndSG1)
  ,(0, Rrule CohideR 0)
  ,(Suc (Suc 0), Lrule ImplyL 0)
  ,(Suc (Suc (Suc 0)), CloseId 1 0)
  ,(Suc (Suc 0), Lrule ImplyL 0)
  ,(Suc (Suc 0), CloseId 0 0)
  ,(Suc (Suc 0), Cut DIAndCut34Elim1) ― ‹11›
  ,(0, Lrule ImplyL 0)
  ,(Suc (Suc (Suc 0)), Lrule ImplyL 0)
  ,(0, Rrule CohideRR 0)
  ,(0, Rrule CohideRR 0)
  ,(Suc 0, Rrule CohideRR 0)
  ,(Suc (Suc (Suc (Suc (Suc 0)))), G)  
  ,(0, Rrule ImplyR 0)
  ,(Suc (Suc (Suc (Suc (Suc 0)))), Lrule AndL 0)
  ,(Suc (Suc (Suc (Suc (Suc 0)))), CloseId 0 0)
  ,(Suc (Suc (Suc 0)), AxSubst AK DIAndSubst341) ― ‹21›
  ,(Suc (Suc 0), CloseId 0 0)
  ,(Suc 0, CloseId 0 0)
  ,(0, Cut DIAndCut12Intro)
  ,(Suc 0, Rrule CohideRR 0)
  ,(Suc (Suc 0), AxSubst AK DIAndSubst12)
  ,(0, Lrule ImplyL 0)
  ,(1, Lrule ImplyL 0)
  ,(Suc (Suc 0), CloseId 0 0)
  ,(Suc 0, Cut DIAndCutP12)
  ,(0, Lrule ImplyL 0) ― ‹31›
  ,(0, Rrule CohideRR 0)
  ,(Suc (Suc (Suc (Suc 0))), AxSubst AK DIAndCurry12)
  ,(Suc (Suc (Suc 0)), Rrule CohideRR 0)
  ,(Suc (Suc 0), Lrule ImplyL 0)
  ,(Suc (Suc 0), G)  
  ,(0, Rrule ImplyR 0)  
  ,(Suc (Suc (Suc (Suc 0))), Rrule ImplyR 0)  
  ,(Suc (Suc (Suc (Suc 0))), Rrule AndR 0)  
  ,(Suc (Suc (Suc (Suc (Suc 0)))), CloseId 0 0)
  ,(Suc (Suc (Suc (Suc 0))), CloseId 1 0) ― ‹41›
  ,(Suc (Suc  0), CloseId 0 0)   
  ,(Suc 0, Cut DIAndCut34Elim2)
  ,(0, Lrule ImplyL 0)
  ,(0, Rrule CohideRR 0)
  ,(Suc (Suc (Suc (Suc 0))), AxSubst AK DIAndSubst342) ― ‹46›
  ,(Suc (Suc (Suc 0)), Rrule CohideRR 0)
  ,(Suc (Suc (Suc 0)), G) ― ‹48›
  ,(0, Rrule ImplyR 0)
  ,(Suc (Suc (Suc 0)), Lrule AndL 0) ― ‹50›
  ,(Suc (Suc (Suc 0)), CloseId 1 0)
  ,(Suc (Suc 0), Lrule ImplyL 0)
  ,(Suc 0, CloseId 0 0)
  ,(1, Cut DIAndSG2)
  ,(0, Lrule ImplyL 0)
  ,(0, Rrule CohideRR 0)
  ,(Suc (Suc (Suc 0)), CloseId 4 0)
  ,(Suc (Suc 0), Lrule ImplyL 0)
  ,(Suc (Suc (Suc 0)), CloseId 0 0)
  ,(Suc (Suc (Suc 0)), CloseId 0 0)
  ,(1, CloseId 1 0)
  ])
  "

fun proof_take :: "nat ⇒ ('sf,'sc,'sz) pf ⇒ ('sf,'sc,'sz) pf"
where "proof_take n (C,D) = (C,List.take n D)"

fun last_step::"('sf,'sc,'sz) pf ⇒ nat ⇒ nat * ('sf,'sc,'sz ) step"
where "last_step (C,D) n = List.last (take n D)"

lemma DIAndSound_lemma:"sound (proof_result (proof_take 61 DIAndProof))"
  apply(rule proof_sound)
  unfolding DIAndProof_def DIAndConcl_def  DIAndCutP1_def DIAndSG1_def DIAndCut34Elim1_def  DIAndSubst341_def DIAndCut12Intro_def DIAndSubst12_def
    DIAndCutP12_def DIAndCurry12_def DIAndSubst342_def
    DIAndCut34Elim2_def ― ‹43›
    DIAndSG2_def ― ‹54› (* slow *)
  apply (auto simp add: prover)
  done
  
section ‹Example 2: Concrete Hybrid System›

― ‹‹v ≥ 0 ∧ A() ≥ 0 ⟶ [v' = A, x' = v]v' ≥ 0››
definition SystemConcl::"('sf,'sc,'sz) sequent"
where "SystemConcl = 
  ([],[
  Implies (And (Geq (Var vid1) (Const 0)) (Geq (f0 fid1) (Const 0)))
  ([[EvolveODE (OProd (OSing vid1 (f0 fid1)) (OSing vid2 (Var vid1))) (TT)]]Geq (Var vid1) (Const 0))
  ])"

definition SystemDICut :: "('sf,'sc,'sz) formula"
where "SystemDICut =
  Implies
  (Implies TT ([[EvolveODE (OProd (OSing vid1 (f0 fid1)) (OSing vid2 (Var vid1))) TT]]
     (Geq (Differential (Var vid1)) (Differential (Const 0)))))
  (Implies
     (Implies TT (Geq (Var vid1) (Const 0)))
     ([[EvolveODE (OProd (OSing vid1 (f0 fid1)) (OSing vid2 (Var vid1))) TT]](Geq (Var vid1) (Const 0))))"
(*
    (Implies (Geq (Var vid1) (Const 0)) 
      (Implies (And TT ([[EvolveODE (OProd (OSing vid1 (f0 fid1)) (OSing vid2 (Var vid1))) TT]]
                  (Geq (Differential (Var vid1)) (Differential (Const 0)))
   )) ([[EvolveODE (OProd (OSing vid1 (f0 fid1)) (OSing vid2 (Var vid1))) TT]](Geq (Var vid1) (Const 0)))))"
*)  
definition SystemDCCut::"('sf,'sc,'sz) formula"
where "SystemDCCut =
(([[EvolveODE (OProd (OSing vid1 (f0 fid1)) (OSing vid2 (Var vid1))) TT]](Geq (f0 fid1) (Const 0))) →
   (([[EvolveODE (OProd (OSing vid1 (f0 fid1)) (OSing vid2 (Var vid1))) TT]]((Geq (Differential (Var vid1)) (Differential (Const 0))))) 
   ↔  
   ([[EvolveODE (OProd (OSing vid1 (f0 fid1)) (OSing vid2 (Var vid1))) (And TT (Geq (f0 fid1) (Const 0)))]](Geq (Differential (Var vid1)) (Differential (Const 0))))))"
  
definition SystemVCut::"('sf,'sc,'sz) formula"
where "SystemVCut = 
  Implies (Geq (f0 fid1) (Const 0)) ([[EvolveODE (OProd (OSing vid1 (f0 fid1)) (OSing vid2 (Var vid1))) (And TT (Geq (f0 fid1) (Const 0)))]](Geq (f0 fid1) (Const 0)))" 

definition SystemVCut2::"('sf,'sc,'sz) formula"
where "SystemVCut2 = 
  Implies (Geq (f0 fid1) (Const 0)) ([[EvolveODE (OProd (OSing vid1 (f0 fid1)) (OSing vid2 (Var vid1))) TT]](Geq (f0 fid1) (Const 0)))" 

definition SystemDECut::"('sf,'sc,'sz) formula"
where "SystemDECut = (([[EvolveODE (OProd (OSing vid1 (f0 fid1)) (OSing vid2 (Var vid1))) (And TT (Geq (f0 fid1) (Const 0)))]] ((Geq (Differential (Var vid1)) (Differential (Const 0))))) ↔
 ([[EvolveODE (OProd (OSing vid1 (f0 fid1)) (OSing vid2 (Var vid1))) (And TT (Geq (f0 fid1) (Const 0)))]]
    [[DiffAssign vid1 (f0 fid1)]](Geq (Differential (Var vid1)) (Differential (Const 0)))))"

definition SystemKCut::"('sf,'sc,'sz) formula"
where "SystemKCut =
  (Implies ([[EvolveODE (OProd (OSing vid1 (f0 fid1)) (OSing vid2 (Var vid1))) (And TT (Geq (f0 fid1) (Const 0)))]]
                (Implies ((And TT (Geq (f0 fid1) (Const 0)))) ([[DiffAssign vid1 (f0 fid1)]](Geq (Differential (Var vid1)) (Differential (Const 0))))))
      (Implies ([[EvolveODE (OProd (OSing vid1 (f0 fid1)) (OSing vid2 (Var vid1))) (And TT (Geq (f0 fid1) (Const 0)))]] ((And TT (Geq (f0 fid1) (Const 0)))))
               ([[EvolveODE (OProd (OSing vid1 (f0 fid1)) (OSing vid2 (Var vid1))) (And TT (Geq (f0 fid1) (Const 0)))]] ([[DiffAssign vid1 (f0 fid1)]](Geq (Differential (Var vid1)) (Differential (Const 0)))))))"

definition SystemEquivCut::"('sf,'sc,'sz) formula"
where "SystemEquivCut =
  (Equiv (Implies ((And TT (Geq (f0 fid1) (Const 0)))) ([[DiffAssign vid1 (f0 fid1)]](Geq (Differential (Var vid1)) (Differential (Const 0)))))
         (Implies ((And TT (Geq (f0 fid1) (Const 0)))) ([[DiffAssign vid1 (f0 fid1)]](Geq (DiffVar vid1) (Const 0)))))"

definition SystemDiffAssignCut::"('sf,'sc,'sz) formula"
where "SystemDiffAssignCut =
  (([[DiffAssign vid1  ($f fid1 empty)]] (Geq (DiffVar vid1) (Const 0)))
↔ (Geq ($f fid1 empty) (Const 0)))"
  
definition SystemCEFml1::"('sf,'sc,'sz) formula"
where "SystemCEFml1 = Geq (Differential (Var vid1)) (Differential (Const 0))"

definition SystemCEFml2::"('sf,'sc,'sz) formula"
where "SystemCEFml2 = Geq (DiffVar vid1) (Const 0)"


(*
definition diff_const_axiom :: "('sf, 'sc, 'sz) formula"
  where [axiom_defs]:"diff_const_axiom ≡ Equals (Differential ($f fid1 empty)) (Const 0)"

definition diff_var_axiom :: "('sf, 'sc, 'sz) formula"
  where [axiom_defs]:"diff_var_axiom ≡ Equals (Differential (Var vid1)) (DiffVar vid1)"*)

  
definition CQ1Concl::"('sf,'sc,'sz) formula"
where "CQ1Concl = (Geq (Differential (Var vid1)) (Differential (Const 0)) ↔ Geq (DiffVar vid1) (Differential (Const 0)))"

definition CQ2Concl::"('sf,'sc,'sz) formula"
where "CQ2Concl = (Geq (DiffVar vid1) (Differential (Const 0)) ↔ Geq ($' vid1) (Const 0))"

definition CEReq::"('sf,'sc,'sz) formula"
where "CEReq = (Geq (Differential (trm.Var vid1)) (Differential (Const 0)) ↔ Geq ($' vid1) (Const 0))"

definition CQRightSubst::"('sf,'sc,'sz) subst"
where "CQRightSubst = 
  ⦇ SFunctions = (λ_. None),
    SPredicates = (λp. (if p = vid1 then (Some (Geq (DiffVar vid1) (Function  (Inr vid1)  empty))) else None)),
    SContexts = (λ_. None),
    SPrograms = (λ_. None),
    SODEs = (λ_. None)
  ⦈"


definition CQLeftSubst::"('sf,'sc,'sz) subst"
where "CQLeftSubst = 
  ⦇ SFunctions = (λ_. None),
    SPredicates = (λp. (if p = vid1 then (Some (Geq  (Function  (Inr vid1)  empty) (Differential (Const 0)))) else None)),
    SContexts = (λ_. None),
    SPrograms = (λ_. None),
    SODEs = (λ_. None)
  ⦈"

definition CEProof::"('sf,'sc,'sz) pf"
where "CEProof = (([],[CEReq]), [
  (0, Cut CQ1Concl)
 ,(0, Cut CQ2Concl)
 ,(1, Rrule CohideRR 0)
 ,(Suc (Suc 0), CQ (Differential (Const 0)) (Const 0) CQRightSubst)
 ,(1, Rrule CohideRR 0)
 ,(1, CQ (Differential (Var vid1)) (DiffVar vid1) CQLeftSubst)
 ,(0, Rrule EquivR 0)
 ,(0, Lrule EquivForwardL 1)
 ,(Suc (Suc 0), Lrule EquivForwardL 1)
 ,(Suc (Suc (Suc 0)), CloseId 0 0)
 ,(Suc (Suc 0), CloseId 0 0)
 ,(Suc 0, CloseId 0 0)
 ,(0, Lrule EquivBackwardL (Suc (Suc 0)))
 ,(0, CloseId 0 0)
 ,(0, Lrule EquivBackwardL (Suc 0))
 ,(0, CloseId 0 0)
 ,(0, CloseId 0 0)
 ])"  

lemma CE_result_correct:"proof_result CEProof = ([],([],[CEReq]))"
  unfolding CEProof_def CEReq_def CQ1Concl_def  CQ2Concl_def Implies_def Or_def f0_def TT_def Equiv_def Box_def CQRightSubst_def
  by (auto simp add: id_simps)

definition DiffConstSubst::"('sf,'sc,'sz) subst"
where "DiffConstSubst = ⦇
    SFunctions = (λf. (if f = fid1 then (Some (Const 0)) else None)),
    SPredicates = (λ_. None),
    SContexts = (λ_. None),
    SPrograms = (λ_. None),
    SODEs = (λ_. None)
  ⦈"

definition DiffConstProof::"('sf,'sc,'sz) pf"
where "DiffConstProof = (([],[(Equals (Differential (Const 0)) (Const 0))]), [
  (0, AxSubst AdConst DiffConstSubst)])"

lemma diffconst_result_correct:"proof_result DiffConstProof = ([], ([],[Equals (Differential (Const 0)) (Const 0)]))"
  by(auto simp add: prover DiffConstProof_def)

lemma diffconst_sound_lemma:"sound (proof_result DiffConstProof)"
  apply(rule proof_sound)
  unfolding DiffConstProof_def
  by (auto simp add: prover DiffConstProof_def DiffConstSubst_def Equals_def empty_def TUadmit_def)
  
lemma valid_of_sound:"sound ([], ([],[φ])) ⟹ valid φ"
  unfolding valid_def sound_def TT_def FF_def 
  apply (auto simp add: TT_def FF_def Or_def)
  subgoal for I a b
    apply(erule allE[where x=I])
    by(auto)
  done

lemma almost_diff_const_sound:"sound ([], ([], [Equals (Differential (Const 0)) (Const 0)]))"
  using diffconst_result_correct diffconst_sound_lemma by simp

lemma almost_diff_const:"valid (Equals (Differential (Const 0)) (Const 0))"
  using almost_diff_const_sound valid_of_sound by auto

― ‹Note: this is just unpacking the definition: the axiom is defined as literally this formula›
lemma almost_diff_var:"valid (Equals (Differential (trm.Var vid1)) ($' vid1))"
  using diff_var_axiom_valid unfolding diff_var_axiom_def by auto

lemma CESound_lemma:"sound (proof_result CEProof)"
  apply(rule proof_sound)
  unfolding CEProof_def CEReq_def CQ1Concl_def CQ2Concl_def Equiv_def CQRightSubst_def diff_const_axiom_valid diff_var_axiom_valid empty_def Or_def expand_singleton 
  diff_var_axiom_def
  by (auto simp add: prover CEProof_def CEReq_def CQ1Concl_def CQ2Concl_def Equiv_def
    CQRightSubst_def diff_const_axiom_valid diff_var_axiom_valid empty_def Or_def expand_singleton 
    TUadmit_def NTUadmit_def almost_diff_const CQLeftSubst_def almost_diff_var)

lemma sound_to_valid:"sound ([], ([], [φ])) ⟹ valid φ"
  unfolding  valid_def apply auto
  apply(drule soundD_mem)
  by (auto simp add: member_rec(2))
  
lemma CE1pre:"sound ([], ([], [CEReq]))"  
  using CE_result_correct CESound_lemma 
  by simp
                            
lemma CE1pre_valid:"valid CEReq"
  by (rule sound_to_valid[OF CE1pre])
    
lemma CE1pre_valid2:"valid (! (! (Geq (Differential (trm.Var vid1)) (Differential (Const 0)) && Geq ($' vid1) (Const 0)) &&
              ! (! (Geq (Differential (trm.Var vid1)) (Differential (Const 0))) && ! (Geq ($' vid1) (Const 0))))) "
  using CE1pre_valid unfolding CEReq_def Equiv_def Or_def by auto

definition SystemDISubst::"('sf,'sc,'sz) subst"
where "SystemDISubst = 
  ⦇ SFunctions = (λf. 
    (     if f = fid1 then Some(Function (Inr vid1) empty)
     else if f = fid2 then Some(Const 0)
     else None)),
    SPredicates = (λp. if p = vid1 then Some TT else None),
    SContexts = (λ_. None),
    SPrograms = (λ_. None),
    SODEs = (λc. if c = vid1 then Some (OProd (OSing vid1 (f0 fid1)) (OSing vid2 (trm.Var vid1))) else None)
  ⦈"
  
  (*
  Implies 
  (Implies (Prop vid1 empty) ([[EvolveODE (OVar vid1) (Prop vid1 empty)]](Geq (Differential (f1 fid1 vid1)) (Differential (f1 fid2 vid1)))))
  (Implies
     (Implies(Prop vid1 empty) (Geq (f1 fid1 vid1) (f1 fid2 vid1)))
     ([[EvolveODE (OVar vid1) (Prop vid1 empty)]](Geq (f1 fid1 vid1) (f1 fid2 vid1))))"
*)
(*
Implies
  (Implies TT ([[EvolveODE (OProd (OSing vid1 (f0 fid1)) (OSing vid2 (Var vid1))) TT]]
     (Geq (Differential (Var vid1)) (Differential (Const 0)))))
  (Implies
     (Implies TT (Geq (Var vid1) (Const 0)))
     ([[EvolveODE (OProd (OSing vid1 (f0 fid1)) (OSing vid2 (Var vid1))) TT]](Geq (Var vid1) (Const 0))))
*)

definition SystemDCSubst::"('sf,'sc,'sz) subst"
where "SystemDCSubst = 
  ⦇ SFunctions = (λ
  f.  None),
    SPredicates = (λp.  None),
    SContexts = (λC. 
    if C = pid1 then
      Some TT
    else if C = pid2 then
      Some (Geq (Differential (Var vid1)) (Differential (Const 0)))
    else if C = pid3 then
      Some (Geq (Function fid1 empty) (Const 0)) 
    else 
     None),
    SPrograms = (λ_. None),
    SODEs = (λc. if c = vid1 then Some (OProd (OSing vid1 (Function fid1 empty)) (OSing vid2 (trm.Var vid1))) else None)
  ⦈"

definition SystemVSubst::"('sf,'sc,'sz) subst"
where "SystemVSubst = 
  ⦇ SFunctions = (λf.  None),
    SPredicates = (λp. if p = vid1 then Some (Geq (Function (Inl fid1) empty) (Const 0)) else None),
    SContexts = (λ_. None),
    SPrograms = (λa. if a = vid1 then 
      Some (EvolveODE (OProd 
                         (OSing vid1 (Function fid1 empty)) 
                         (OSing vid2 (Var vid1))) 
                      (And TT (Geq (Function fid1 empty) (Const 0)))) 
                      else None),
    SODEs = (λ_. None)
  ⦈"

definition SystemVSubst2::"('sf,'sc,'sz) subst"
where "SystemVSubst2 = 
  ⦇ SFunctions = (λf.  None),
    SPredicates = (λp. if p = vid1 then Some (Geq (Function (Inl fid1) empty) (Const 0)) else None),
    SContexts = (λ_. None),
    SPrograms = (λa. if a = vid1 then 
      Some (EvolveODE (OProd 
                         (OSing vid1 (Function fid1 empty)) 
                         (OSing vid2 (Var vid1))) 
                      TT) 
                      else None),
    SODEs = (λ_. None)
  ⦈"

definition SystemDESubst::"('sf,'sc,'sz) subst"
where "SystemDESubst = 
  ⦇ SFunctions = (λf. if f = fid1 then Some(Function (Inl fid1) empty) else None),
    SPredicates = (λp. if p = vid2 then Some(And TT (Geq (Function (Inl fid1) empty) (Const 0))) else None),
    SContexts = (λC. if C = pid1 then Some(Geq (Differential (Var vid1)) (Differential (Const 0))) else None),
    SPrograms = (λ_. None),
    SODEs = (λ_. None)
  ⦈"

lemma systemdesubst_correct:"∃ ODE.(([[EvolveODE (OProd (OSing vid1 (f0 fid1)) (OSing vid2 (Var vid1))) (And TT (Geq (f0 fid1) (Const 0)))]] ((Geq (Differential (Var vid1)) (Differential (Const 0))))) ↔
 ([[EvolveODE (OProd (OSing vid1 (f0 fid1)) (OSing vid2 (Var vid1))) (And TT (Geq (f0 fid1) (Const 0)))]]
    [[DiffAssign vid1 (f0 fid1)]](Geq (Differential (Var vid1)) (Differential (Const 0)))))
    = Fsubst ((([[EvolveODE (OProd (OSing vid1 (f1 fid1 vid1)) ODE) (p1 vid2 vid1)]] (P pid1)) ↔
          ([[EvolveODE ((OProd  (OSing vid1 (f1 fid1 vid1))) ODE) (p1 vid2 vid1)]]
               [[DiffAssign vid1 (f1 fid1 vid1)]]P pid1))) SystemDESubst"
  apply(rule exI[where x="OSing vid2 (trm.Var vid1)"])
  by(auto simp add: f0_def f1_def Box_def Or_def Equiv_def empty_def TT_def P_def p1_def SystemDESubst_def empty_def)
  
― ‹‹[{dx=, dy=x&r>=r&>=r}]r>=r&>=r->[D{x}:=]D{x}>=D{r}->››
― ‹‹[{dx=, dy=x&r>=r&>=r}]r>=r&>=r->››
― ‹‹[{dx=, dy=x&r>=r&>=r}][D{x}:=]D{x}>=D{r}››
― ‹‹([[$α vid1]]((Predicational pid1) → (Predicational pid2)))››
― ‹‹→ ([[$α vid1]]Predicational pid1) → ([[$α vid1]]Predicational pid2)››
definition SystemKSubst::"('sf,'sc,'sz) subst"
where "SystemKSubst = ⦇ SFunctions = (λf.  None),
    SPredicates = (λ_. None),
    SContexts = (λC. if C = pid1 then 
        (Some (And (Geq (Const 0) (Const 0)) (Geq (Function fid1 empty) (Const 0)))) 
      else if C = pid2 then 
        (Some ([[DiffAssign vid1 (Function fid1 empty)]](Geq (Differential (Var vid1)) (Differential (Const 0))))) else None),
    SPrograms = (λc. if c = vid1 then Some (EvolveODE (OProd (OSing vid1 (Function fid1 empty)) (OSing vid2 (Var vid1))) (And (Geq (Const 0) (Const 0)) (Geq (Function fid1 empty) (Const 0)))) else None),
    SODEs = (λ_. None)
  ⦈"

lemma subst_imp_simp:"Fsubst (Implies p q) σ = (Implies (Fsubst p σ) (Fsubst q σ))"
  unfolding Implies_def Or_def by auto

lemma subst_equiv_simp:"Fsubst (Equiv p q) σ = (Equiv (Fsubst p σ) (Fsubst q σ))"
  unfolding Implies_def Or_def Equiv_def by auto

lemma subst_box_simp:"Fsubst (Box p q) σ = (Box (Psubst p σ) (Fsubst q σ))"
  unfolding Box_def Or_def by auto

lemma pfsubst_box_simp:"PFsubst (Box p q) σ = (Box (PPsubst p σ) (PFsubst q σ))"
  unfolding Box_def Or_def by auto

lemma pfsubst_imp_simp:"PFsubst (Implies p q) σ = (Implies (PFsubst p σ) (PFsubst q σ))"
  unfolding Box_def Implies_def Or_def by auto

definition SystemDWSubst::"('sf,'sc,'sz) subst"
where "SystemDWSubst = ⦇ SFunctions = (λf.  None),
    SPredicates = (λ_. None),
    SContexts = (λC. if C = pid1 then Some (And (Geq (Const 0) (Const 0)) (Geq (Function fid1 empty) (Const 0))) else None),
    SPrograms = (λ_. None),
    SODEs = (λc. if c = vid1 then Some (OProd (OSing vid1 (Function fid1 empty)) (OSing vid2 (Var vid1))) else None)
  ⦈"

definition SystemCESubst::"('sf,'sc,'sz) subst"
where "SystemCESubst = ⦇ SFunctions = (λf.  None),
    SPredicates = (λ_. None),
    SContexts = (λC. if C = pid1 then Some(Implies(And (Geq (Const 0) (Const 0)) (Geq (Function fid1 empty) (Const 0))) ([[DiffAssign vid1 (Function fid1 empty)]](Predicational (Inr ())))) else None),
    SPrograms = (λ_. None),
    SODEs = (λ_. None)
  ⦈"

lemma SystemCESubstOK:
  "step_ok 
  ([([],[Equiv (Implies(And (Geq (Const 0) (Const 0)) (Geq (Function fid1 empty) (Const 0))) ([[DiffAssign vid1 (Function fid1 empty)]]( SystemCEFml1))) 
         (Implies(And (Geq (Const 0) (Const 0)) (Geq (Function fid1 empty) (Const 0))) ([[DiffAssign vid1 (Function fid1 empty)]]( (SystemCEFml2))))
         ])],
         ([],[]))
         
         0 
         (CE SystemCEFml1 SystemCEFml2 SystemCESubst)"
  apply(rule Step_CE)
       subgoal by(auto simp add: subst_equiv_simp subst_imp_simp subst_box_simp SystemCESubst_def SystemCEFml1_def SystemCEFml2_def pfsubst_imp_simp pfsubst_box_simp)
      subgoal using CE1pre_valid 
        by (auto simp add: CEReq_def SystemCEFml1_def SystemCEFml2_def CE1pre_valid)
     subgoal unfolding SystemCEFml1_def by auto
    subgoal unfolding SystemCEFml2_def by auto
   subgoal unfolding SystemCESubst_def ssafe_def Implies_def Box_def Or_def empty_def by auto
  unfolding SystemCESubst_def Equiv_def Or_def SystemCEFml1_def SystemCEFml2_def TUadmit_def apply (auto simp add: TUadmit_def FUadmit_def Box_def Implies_def Or_def)
     unfolding PFUadmit_def by auto
  
― ‹‹[D{x}:=f]Dv{x}>=r<->f>=r››
― ‹‹[[DiffAssign vid1  ($f fid1 empty)]] (Prop vid1 (singleton (DiffVar vid1))))››
― ‹‹↔ Prop vid1 (singleton ($f fid1 empty))››
definition SystemDiffAssignSubst::"('sf,'sc,'sz) subst"
where "SystemDiffAssignSubst = ⦇ SFunctions = (λf.  None),
    SPredicates = (λp. if p = vid1 then Some (Geq (Function (Inr vid1) empty) (Const 0)) else None),
    SContexts = (λ_. None),
    SPrograms = (λ_. None),
    SODEs = (λ_. None)
  ⦈"

lemma SystemDICutCorrect:"SystemDICut = Fsubst DIGeqaxiom SystemDISubst"
  unfolding SystemDICut_def DIGeqaxiom_def SystemDISubst_def 
  by (auto simp add: f1_def p1_def f0_def Implies_def Or_def id_simps TT_def Box_def empty_def)

― ‹‹v≥0 ∧ A()≥0 → [{x'=v, v'=A()}]v≥0››
definition SystemProof :: "('sf, 'sc, 'sz) pf"
where "SystemProof =
  (SystemConcl, [
  (0, Rrule ImplyR 0)
  ,(0, Lrule AndL 0)
  ,(0, Cut SystemDICut)
  ,(0, Lrule ImplyL 0)
  ,(0, Rrule CohideRR 0)
  ,(0, Lrule ImplyL 0)
  ,(Suc (Suc 0), CloseId 0 0)
  ,(Suc 0, AxSubst ADIGeq SystemDISubst) ― ‹8›
  ,(Suc 0, Rrule ImplyR 0)
  ⌦‹,(0, CloseId 0 0)›
  ,(Suc 0, CloseId 1 0)        
  ⌦‹,(0, Rrule AndR 0)›
  ,(0, Rrule ImplyR 0)   
  ,(0, Cut SystemDCCut)
  ,(0, Lrule ImplyL 0)
  ,(0, Rrule CohideRR 0)
  ,(0, Lrule EquivBackwardL 0)
  ,(0, Rrule CohideR 0)
  ,(0, AxSubst ADC SystemDCSubst) ― ‹17›
  ,(0, CloseId 0 0)
  ,(0, Rrule CohideRR 0)
  ,(0, Cut SystemVCut)
  ,(0, Lrule ImplyL 0) 
  ,(0, Rrule CohideRR 0)
  ,(0, Cut SystemDECut)
  ,(0, Lrule EquivBackwardL 0)
  ,(0, Rrule CohideRR 0)
  ,(1, CloseId (Suc 1) 0) ― ‹Last step›
  ,(Suc 1, CloseId 0 0)
  ,(1, AxSubst AV SystemVSubst) ― ‹28›
  ,(0, Cut SystemVCut2)
  
  ,(0, Lrule ImplyL 0)
  ,(0, Rrule CohideRR 0)
  ,(Suc 1, CloseId 0 0)
  ,(Suc 1, CloseId (Suc 2) 0)
  
  ,(Suc 1, AxSubst AV SystemVSubst2) ― ‹34›
  ,(0, Rrule CohideRR 0)
  ,(0, DEAxiomSchema (OSing vid2 (trm.Var vid1)) SystemDESubst) ― ‹36›
  ,(0, Cut SystemKCut)
  ,(0, Lrule ImplyL 0)
  ,(0, Rrule CohideRR 0)
  ,(0, Lrule ImplyL 0)
  ,(0, Rrule CohideRR 0)
  ,(0, AxSubst AK SystemKSubst) ― ‹42›
  ,(0, CloseId 0 0)
  ,(0, Rrule CohideR 0)
  ,(1, AxSubst ADW SystemDWSubst) ― ‹45›
  ,(0, G)
  ,(0, Cut SystemEquivCut)
  ,(0, Lrule EquivBackwardL 0)
  ,(0, Rrule CohideR 0)
  ,(0, CloseId 0 0)
  ,(0, Rrule CohideR 0)
  ,(0, CE SystemCEFml1 SystemCEFml2 SystemCESubst) ― ‹52›
  ,(0, Rrule ImplyR 0)
  ,(0, Lrule AndL 0)
  ,(0, Cut SystemDiffAssignCut) 
  ,(0, Lrule EquivBackwardL 0)
  ,(0, Rrule CohideRR 0)
  ,(0, CloseId 0 0)
  ,(0, CloseId 1 0)
  ,(0, AxSubst Adassign SystemDiffAssignSubst) ― ‹60›
  ])"
  
lemma system_result_correct:"proof_result SystemProof = 
  ([],
  ([],[Implies (And (Geq (Var vid1) (Const 0)) (Geq (f0 fid1) (Const 0)))
        ([[EvolveODE (OProd (OSing vid1 (f0 fid1)) (OSing vid2 (Var vid1))) (TT)]]Geq (Var vid1) (Const 0))]))"
  unfolding SystemProof_def SystemConcl_def Implies_def Or_def f0_def TT_def Equiv_def SystemDICut_def SystemDCCut_def
  proof_result.simps deriv_result.simps start_proof.simps  Box_def SystemDCSubst_def SystemVCut_def SystemDECut_def SystemKCut_def SystemEquivCut_def
  SystemDiffAssignCut_def SystemVCut2_def
    (* slow *)
  apply( simp add:  prover)
  done

lemma SystemSound_lemma:"sound (proof_result SystemProof)"
  apply(rule proof_sound)
  unfolding SystemProof_def SystemConcl_def CQ1Concl_def CQ2Concl_def Equiv_def CQRightSubst_def diff_const_axiom_valid diff_var_axiom_valid empty_def Or_def expand_singleton 
  diff_var_axiom_def SystemDICut_def
  (* slow *)
  apply (auto simp add: prover CEProof_def CEReq_def CQ1Concl_def CQ2Concl_def Equiv_def
    CQRightSubst_def diff_const_axiom_valid diff_var_axiom_valid empty_def Or_def expand_singleton 
    TUadmit_def NTUadmit_def almost_diff_const CQLeftSubst_def almost_diff_var f0_def TT_def SystemDISubst_def f1_def p1_def SystemDCCut_def SystemDCSubst_def
    SystemVCut_def SystemDECut_def SystemVSubst_def
    SystemVCut2_def SystemVSubst2_def  SystemDESubst_def P_def SystemKCut_def  SystemKSubst_def SystemDWSubst_def SystemEquivCut_def
    SystemCESubst_def SystemCEFml1_def SystemCEFml2_def CE1pre_valid2 SystemDiffAssignCut_def SystemDiffAssignSubst_def)
  done

lemma system_sound:"sound ([], SystemConcl)"
  using SystemSound_lemma system_result_correct unfolding SystemConcl_def by auto
  
lemma DIAnd_result_correct:"proof_result (proof_take 61 DIAndProof) = DIAnd"
  unfolding DIAndProof_def DIAndConcl_def Implies_def Or_def 
  proof_result.simps deriv_result.simps start_proof.simps DIAndCutP12_def  DIAndSG1_def DIAndSG2_def DIAndCutP1_def Box_def DIAndCut34Elim1_def DIAndCut12Intro_def DIAndCut34Elim2_def DIAnd_def
  using pne12 pne13 pne14 pne23 pne24 pne34 by (auto)

theorem DIAnd_sound: "sound DIAnd"
  using DIAndSound_lemma DIAnd_result_correct by auto

end end

Theory Ids

Theory Lib

Theory Syntax

Theory Denotational_Semantics

Theory Axioms

Theory Frechet_Correctness

Theory Static_Semantics

Theory Coincidence

Theory Bound_Effect

Theory Differential_Axioms

Theory USubst

Theory USubst_Lemma

Theory Uniform_Renaming

Theory Pretty_Printer

Theory Proof_Checker

Theory Differential_Dynamic_Logic